From d7e889740049994ddfcf43f42825d999ffad5690 Mon Sep 17 00:00:00 2001
From: Jean-Claude Beaudoin <jean.claude.beaudoin@gmail.com>
Date: Sun, 5 Aug 2012 15:49:23 +0200
Subject: [PATCH] Add support for ManKai CommonLisp

---
 bordeaux-threads.asd |  2 ++
 src/impl-mkcl.lisp   | 93 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 95 insertions(+)
 create mode 100644 src/impl-mkcl.lisp

diff --git a/bordeaux-threads.asd b/bordeaux-threads.asd
index bed96f9..aaf6f26 100644
--- a/bordeaux-threads.asd
+++ b/bordeaux-threads.asd
@@ -18,6 +18,7 @@ Distributed under the MIT license (see LICENSE file)
         (and cmu mp)
         corman
         (and ecl threads)
+        mkcl
         lispworks
         (and digitool ccl-5.1)
         (and sbcl sb-thread)
@@ -44,6 +45,7 @@ Distributed under the MIT license (see LICENSE file)
                         #+(and thread-support cmu)       "impl-cmucl"
                         #+(and thread-support corman)    "impl-corman"
                         #+(and thread-support ecl)       "impl-ecl"
+                        #+(and thread-support mkcl)      "impl-mkcl"
                         #+(and thread-support lispworks) "impl-lispworks"
                         #+(and thread-support digitool)  "impl-mcl"
                         #+(and thread-support sbcl)      "impl-sbcl"
diff --git a/src/impl-mkcl.lisp b/src/impl-mkcl.lisp
new file mode 100644
index 0000000..22264e9
--- /dev/null
+++ b/src/impl-mkcl.lisp
@@ -0,0 +1,93 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
+
+#|
+Copyright 2006, 2007 Greg Pfeil
+Copyright 2010 Jean-Claude Beaudoin.
+
+Distributed under the MIT license (see LICENSE file)
+|#
+
+(in-package #:bordeaux-threads)
+
+(deftype thread ()
+  'mt:thread)
+
+;;; Thread Creation
+
+(defun %make-thread (function name)
+  (mt:thread-run-function name function))
+
+(defun current-thread ()
+  mt::*thread*)
+
+(defun threadp (object)
+  (typep object 'mt:thread))
+
+(defun thread-name (thread)
+  (mt:thread-name thread))
+
+;;; Resource contention: locks and recursive locks
+
+(defun make-lock (&optional name)
+  (mt:make-lock :name (or name "Anonymous lock")))
+
+(defun acquire-lock (lock &optional (wait-p t))
+  (mt:get-lock lock wait-p))
+
+(defun release-lock (lock)
+  (mt:giveup-lock lock))
+
+(defmacro with-lock-held ((place) &body body)
+  `(mt:with-lock (,place) ,@body))
+
+(defun make-recursive-lock (&optional name)
+  (mt:make-lock :name (or name "Anonymous recursive lock") :recursive t))
+
+(defun acquire-recursive-lock (lock &optional (wait-p t))
+  (mt:get-lock lock wait-p))
+
+(defun release-recursive-lock (lock)
+  (mt:giveup-lock lock))
+
+(defmacro with-recursive-lock-held ((place) &body body)
+  `(mt:with-lock (,place) ,@body))
+
+;;; Resource contention: condition variables
+
+(defun make-condition-variable (&key name)
+  (declare (ignore name))
+  (mt:make-condition-variable))
+
+(defun condition-wait (condition-variable lock)
+  (mt:condition-wait condition-variable lock))
+
+(defun condition-notify (condition-variable)
+  (mt:condition-signal condition-variable))
+
+(defun thread-yield ()
+  (mt:thread-yield))
+
+;;; Introspection/debugging
+
+(defun all-threads ()
+  (mt:all-threads))
+
+(defun interrupt-thread (thread function &rest args)
+  (flet ((apply-function ()
+           (if args
+               (lambda () (apply function args))
+               function)))
+    (declare (dynamic-extent #'apply-function))
+    (mt:interrupt-thread thread (apply-function))))
+
+(defun destroy-thread (thread)
+  (signal-error-if-current-thread thread)
+  (mt:thread-kill thread))
+
+(defun thread-alive-p (thread)
+  (mt:thread-active-p thread))
+
+(defun join-thread (thread)
+  (mt:thread-join thread))
+
+(mark-supported)
-- 
2.11.4.GIT