Tmux etc

sbcl/.quicklisp/dists/quicklisp/software/bordeaux-threads-v0.8.7/src/impl-clisp.lisp

@@ -0,0 +1,105 @@
+;;;; -*- indent-tabs-mode: nil -*-
+
+#|
+Copyright 2006, 2007 Greg Pfeil
+
+Distributed under the MIT license (see LICENSE file)
+|#
+
+(in-package #:bordeaux-threads)
+
+(deftype thread ()
+  'mt:thread)
+
+;;; Thread Creation
+(defun %make-thread (function name)
+  (mt:make-thread function
+                  :name name
+                  :initial-bindings mt:*default-special-bindings*))
+
+(defun current-thread ()
+  (mt:current-thread))
+
+(defun threadp (object)
+  (mt:threadp object))
+
+(defun thread-name (thread)
+  (mt:thread-name thread))
+
+;;; Resource contention: locks and recursive locks
+
+(deftype lock () 'mt:mutex)
+
+(deftype recursive-lock ()
+  '(and mt:mutex (satisfies mt:mutex-recursive-p)))
+
+(defun lock-p (object)
+  (typep object 'mt:mutex))
+
+(defun recursive-lock-p (object)
+  (and (typep object 'mt:mutex)
+       (mt:mutex-recursive-p object)))
+
+(defun make-lock (&optional name)
+  (mt:make-mutex :name (or name "Anonymous lock")))
+
+(defun acquire-lock (lock &optional (wait-p t))
+  (mt:mutex-lock lock :timeout (if wait-p nil 0)))
+
+(defun release-lock (lock)
+  (mt:mutex-unlock lock))
+
+(defmacro with-lock-held ((place) &body body)
+  `(mt:with-mutex-lock (,place) ,@body))
+
+(defun make-recursive-lock (&optional name)
+  (mt:make-mutex :name (or name "Anonymous recursive lock")
+                 :recursive-p t))
+
+(defmacro with-recursive-lock-held ((place) &body body)
+  `(mt:with-mutex-lock (,place) ,@body))
+
+;;; Resource contention: condition variables
+
+(defun make-condition-variable (&key name)
+  (mt:make-exemption :name (or name "Anonymous condition variable")))
+
+(defun condition-wait (condition-variable lock &key timeout)
+  (mt:exemption-wait condition-variable lock :timeout timeout)
+  t)
+
+(defun condition-notify (condition-variable)
+  (mt:exemption-signal condition-variable))
+
+(defun thread-yield ()
+  (mt:thread-yield))
+
+;;; Timeouts
+
+(defmacro with-timeout ((timeout) &body body)
+  (once-only (timeout)
+    `(mt:with-timeout (,timeout (error 'timeout :length ,timeout))
+       ,@body)))
+
+;;; Introspection/debugging
+
+;;; VTZ: mt:list-threads returns all threads that are not garbage collected.
+(defun all-threads ()
+  (delete-if-not #'mt:thread-active-p (mt:list-threads)))
+
+(defun interrupt-thread (thread function &rest args)
+  (mt:thread-interrupt thread :function function :arguments args))
+
+(defun destroy-thread (thread)
+  ;;; VTZ: actually we can kill ourselelf.
+  ;;; suicide is part of our contemporary life :)
+  (signal-error-if-current-thread thread)
+  (mt:thread-interrupt thread :function t))
+
+(defun thread-alive-p (thread)
+  (mt:thread-active-p thread))
+
+(defun join-thread (thread)
+  (mt:thread-join thread))
+
+(mark-supported)