+ (setf *session* (new-session)))
+
+(defun %delete-thread-from-session (tid session)
+ (with-mutex ((session-lock session))
+ (setf (session-threads session)
+ (delete tid (session-threads session))
+ (session-interactive-threads session)
+ (delete tid (session-interactive-threads session)))))
+
+(defun call-with-new-session (fn)
+ (%delete-thread-from-session (current-thread-id) *session*)
+ (let ((*session* (new-session))) (funcall fn)))
+
+(defmacro with-new-session (args &body forms)
+ (declare (ignore args)) ;for extensibility
+ (sb!int:with-unique-names (fb-name)
+ `(labels ((,fb-name () ,@forms))
+ (call-with-new-session (function ,fb-name)))))
+
+;;; Remove thread id TID from its session, if it has one. This is
+;;; called from C reap_dead_threads() so is run in the context of
+;;; whichever thread called that (usually after a GC), which may not have
+;;; any meaningful parent/child/sibling relationship with the dead thread
+(defun handle-thread-exit (tid)
+ (let ((session (symbol-value-in-thread '*session* tid)))
+ (and session (%delete-thread-from-session tid session))))
+
+(defun terminate-session ()
+ "Kill all threads in session except for this one. Does nothing if current
+thread is not the foreground thread"
+ (reap-dead-threads)
+ (let* ((tid (current-thread-id))
+ (to-kill
+ (with-mutex ((session-lock *session*))
+ (and (eql tid (car (session-interactive-threads *session*)))
+ (session-threads *session*)))))
+ ;; do the kill after dropping the mutex; unwind forms in dying
+ ;; threads may want to do session things
+ (dolist (p to-kill)
+ (unless (eql p tid) (terminate-thread p)))))