to be joined. The offending thread can be accessed using
THREAD-ERROR-THREAD."))
-(defun join-thread-error-thread (condition)
+(define-deprecated-function :late "1.0.29.17" join-thread-error-thread thread-error-thread
+ (condition)
(thread-error-thread condition))
-(define-compiler-macro join-thread-error-thread (condition)
- (deprecation-warning 'join-thread-error-thread 'thread-error-thread)
- `(thread-error-thread ,condition))
-
-#!+sb-doc
-(setf
- (fdocumentation 'join-thread-error-thread 'function)
- "The thread that we failed to join. Deprecated, use THREAD-ERROR-THREAD
-instead.")
(define-condition interrupt-thread-error (thread-error) ()
(:report (lambda (c s)
"Signalled when interrupting a thread fails because the thread has already
exited. The offending thread can be accessed using THREAD-ERROR-THREAD."))
-(defun interrupt-thread-error-thread (condition)
+(define-deprecated-function :late "1.0.29.17" interrupt-thread-error-thread thread-error-thread
+ (condition)
(thread-error-thread condition))
-(define-compiler-macro interrupt-thread-error-thread (condition)
- (deprecation-warning 'join-thread-error-thread 'thread-error-thread)
- `(thread-error-thread ,condition))
-
-#!+sb-doc
-(setf
- (fdocumentation 'interrupt-thread-error-thread 'function)
- "The thread that was not interrupted. Deprecated, use THREAD-ERROR-THREAD
-instead.")
;;; Of the WITH-PINNED-OBJECTS in this file, not every single one is
;;; necessary because threads are only supported with the conservative
#!-sb-lutex
(token nil))
+(def!method print-object ((waitqueue waitqueue) stream)
+ (print-unreadable-object (waitqueue stream :type t :identity t)
+ (format stream "~@[~A~]" (waitqueue-name waitqueue))))
+
(defun make-waitqueue (&key name)
#!+sb-doc
"Create a waitqueue."
(defun condition-wait (queue mutex)
#!+sb-doc
- "Atomically release MUTEX and enqueue ourselves on QUEUE. Another
-thread may subsequently notify us using CONDITION-NOTIFY, at which
-time we reacquire MUTEX and return to the caller.
-
-Note that if CONDITION-WAIT unwinds (due to eg. a timeout) instead of
+ "Atomically release MUTEX and enqueue ourselves on QUEUE. Another thread may
+subsequently notify us using CONDITION-NOTIFY, at which time we reacquire
+MUTEX and return to the caller.
+
+Important: CONDITION-WAIT may return without CONDITION-NOTIFY having occurred.
+The correct way to write code that uses CONDITION-WAIT is to loop around the
+call, checking the the associated data:
+
+ (defvar *data* nil)
+ (defvar *queue* (make-waitqueue))
+ (defvar *lock* (make-mutex))
+
+ ;; Consumer
+ (defun pop-data ()
+ (with-mutex (*lock*)
+ (loop until *data*
+ do (condition-wait *queue* *lock*))
+ (pop *data*)))
+
+ ;; Producer
+ (defun push-data (data)
+ (with-mutex (*lock*)
+ (push data *data*)
+ (condition-notify *queue*)))
+
+Also note that if CONDITION-WAIT unwinds (due to eg. a timeout) instead of
returning normally, it may do so without holding the mutex."
#!-sb-thread (declare (ignore queue))
(assert mutex)
(setf (sap-ref-word (%thread-sap thread) offset)
(get-lisp-obj-address value))
(values value :ok))))
- (values nil :thread-dead))))))
+ (values nil :thread-dead)))))
+
+ (define-alien-variable tls-index-start unsigned-int)
+
+ ;; Get values from the TLS.
+ (defun %thread-local-values (thread)
+ (without-gcing
+ (when (thread-alive-p thread)
+ (let ((sap (%thread-sap thread)))
+ (loop for index from tls-index-start below
+ (symbol-value 'sb!vm::*free-tls-index*)
+ for value = (sap-ref-word sap (* sb!vm:n-word-bytes index))
+ for obj = (sb!kernel:make-lisp-obj value nil)
+ unless (or (typep obj '(or boolean fixnum character))
+ (member value
+ '(#.sb!vm:no-tls-value-marker-widetag
+ #.sb!vm:unbound-marker-widetag)))
+ collect obj))))))
(defun symbol-value-in-thread (symbol thread &optional (errorp t))
"Return the local value of SYMBOL in THREAD, and a secondary value of T