Tmux etc

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

@@ -0,0 +1,68 @@
+;;;; -*- indent-tabs-mode: nil -*-
+
+#|
+Copyright 2006, 2007 Greg Pfeil
+
+Distributed under the MIT license (see LICENSE file)
+|#
+
+(in-package #:bordeaux-threads)
+
+(deftype thread ()
+  'ccl::process)
+
+;;; Thread Creation
+
+(defun %make-thread (function name)
+  (ccl:process-run-function name function))
+
+(defun current-thread ()
+  ccl:*current-process*)
+
+(defun threadp (object)
+  (ccl::processp object))
+
+(defun thread-name (thread)
+  (ccl:process-name thread))
+
+;;; Resource contention: locks and recursive locks
+
+(deftype lock () 'ccl:lock)
+
+(defun lock-p (object)
+  (typep object 'ccl:lock))
+
+(defun make-lock (&optional name)
+  (ccl:make-lock (or name "Anonymous lock")))
+
+(defun acquire-lock (lock &optional (wait-p t))
+  (if wait-p
+    (ccl:process-lock lock ccl:*current-process*)
+    ;; this is broken, but it's better than a no-op
+    (ccl:without-interrupts
+     (when (null (ccl::lock.value lock))
+       (ccl:process-lock lock ccl:*current-process*)))))
+
+(defun release-lock (lock)
+  (ccl:process-unlock lock))
+
+(defmacro with-lock-held ((place) &body body)
+  `(ccl:with-lock-grabbed (,place) ,@body))
+
+(defun thread-yield ()
+  (ccl:process-allow-schedule))
+
+;;; Introspection/debugging
+
+(defun all-threads ()
+  ccl:*all-processes*)
+
+(defun interrupt-thread (thread function &rest args)
+  (declare (dynamic-extent args))
+  (apply #'ccl:process-interrupt thread function args))
+
+(defun destroy-thread (thread)
+  (signal-error-if-current-thread thread)
+  (ccl:process-kill thread))
+
+(mark-supported)