From b22002b6a9f29051c02eeb2e1830c2b042dfb233 Mon Sep 17 00:00:00 2001
From: Daniel Kochmanski <daniel@turtleware.eu>
Date: Tue, 28 Nov 2017 10:07:17 +0100
Subject: [PATCH] cleanup: locking improvements

[cherry-picked from
https://github.com/sharplispers/log4cl/commit/dcdc5add110bf06530d36d1d9623907c72e097d1]

- don't use bordeaux-threads package (add explicit package prefix)
- serialized appender lock is now recursive - fixes #8
- add names to locks for easier identification (in case of deadlock detection)
---
 src/appender.lisp       | 8 ++++----
 src/hierarchy-base.lisp | 4 ++--
 src/hierarchy.lisp      | 4 ++--
 src/impl-package.lisp   | 2 +-
 src/pattern-layout.lisp | 2 +-
 5 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/src/appender.lisp b/src/appender.lisp
index 88e83f4..eb57e38 100644
--- a/src/appender.lisp
+++ b/src/appender.lisp
@@ -61,7 +61,7 @@ APPENDER-DO-APPEND was called, and writes its output to null sink"))
 appender if it encounters an error matching ERROR-TYPE"))
 
 (defclass serialized-appender (appender)
-  ((%lock :initform (make-lock)))
+  ((%lock :initform (bt:make-recursive-lock "Log4CL serialized appender lock")))
   (:documentation "Appender that serializes itself using a lock"))
 
 (defclass stream-appender (serialized-appender)
@@ -193,7 +193,7 @@ unless IMMEDAITE-FLUSH property is set."
           ;; flush then.
           (when (> (+ since-last-flush *hierarchy-watcher-heartbeat*)
                    flush-interval)
-            (with-lock-held (%lock)
+            (bt:with-recursive-lock-held (%lock)
               (setf %last-flush-time    time
                     %output-since-flush nil)
               (finish-output (appender-stream appender)))))))))
@@ -224,7 +224,7 @@ been any output. TIME will be used to mark the time of the flush"
       appender
     (when (and (not immediate-flush)
                %output-since-flush)
-      (with-lock-held (%lock)
+      (bt:with-recursive-lock-held (%lock)
         (setf %last-flush-time    time
               %output-since-flush nil)
         (finish-output (appender-stream appender))))))
@@ -248,7 +248,7 @@ time of the flush with TIME"
 (defmethod appender-do-append :around
     ((this serialized-appender) logger level log-func)
   (declare (ignore logger level log-func))
-  (with-lock-held ((slot-value this '%lock))
+  (bt:with-recursive-lock-held ((slot-value this '%lock))
     (call-next-method)))
 
 (defmethod appender-do-append ((this stream-appender) logger level log-func)
diff --git a/src/hierarchy-base.lisp b/src/hierarchy-base.lisp
index cb1918a..ce99a9a 100644
--- a/src/hierarchy-base.lisp
+++ b/src/hierarchy-base.lisp
@@ -25,7 +25,7 @@ appenders")
 indexed by this variable. Can be assigned directly or ")
 
 (defvar *hierarchy-lock*
-  (make-recursive-lock "hierarchy-lock")
+  (bt:make-recursive-lock "Log4CL global configuration lock")
   "Global lock for changing logging configuration")
 
 (defvar *hierarchy-watcher-heartbeat* 1
@@ -49,7 +49,7 @@ WATCHER-HOOK of each hierarchy")
    ;; Used for auto-reloading the modified files in
    ;; PROPERTY-CONFIGURATOR but can be used for other stuff.
    (watch-tokens :initform nil :accessor watch-tokens)
-   (%lock :initform (make-lock))))
+   (%lock :initform (bt:make-recursive-lock "Log4CL hierarchy lock"))))
 
 (defvar *hierarchies*
   (make-array 1 :adjustable t :fill-pointer t
diff --git a/src/hierarchy.lisp b/src/hierarchy.lisp
index 30d80d0..41fb719 100644
--- a/src/hierarchy.lisp
+++ b/src/hierarchy.lisp
@@ -35,12 +35,12 @@
   (aref *hierarchies* *hierarchy*))
 
 (defmacro with-hierarchies-lock (&body body)
-  `(with-recursive-lock-held (*hierarchy-lock*)
+  `(bt:with-recursive-lock-held (*hierarchy-lock*)
      ,@body))
 
 (defmacro with-hierarchy-lock ((&optional (hierarchy (current-hierarchy)))
                                &body body)
-  `(with-recursive-lock-held ((slot-value ,hierarchy '%lock))
+  `(bt:with-recursive-lock-held ((slot-value ,hierarchy '%lock))
      ,@body))
 
 
diff --git a/src/impl-package.lisp b/src/impl-package.lisp
index 6301aa2..ab701a6 100644
--- a/src/impl-package.lisp
+++ b/src/impl-package.lisp
@@ -208,7 +208,7 @@
                 (defpackage-form
                   `(defpackage #:log4cl-impl
                      (:nicknames #:log4cl)
-                     (:use #:cl #:bordeaux-threads)
+                     (:use #:cl)
                      (:export ,@new-exports))))
            (when (and p2 removed-exports)
              (unexport removed-exports p2))
diff --git a/src/pattern-layout.lisp b/src/pattern-layout.lisp
index 7ecda15..2981555 100644
--- a/src/pattern-layout.lisp
+++ b/src/pattern-layout.lisp
@@ -1127,7 +1127,7 @@ strftime like PATTERN."))
 (define-pattern-formatter (#\t)
   "Output %t (thread name) pattern"
   (declare (ignore logger log-level log-func))
-  (format-string (or (thread-name (current-thread)) "") stream fmt-info))
+  (format-string (or (bt:thread-name (bt:current-thread)) "") stream fmt-info))
 
 (define-pattern-formatter (#\x)
   (declare (ignore logger log-level log-func))