- (let ((recursive-level 0))
- (defun threads-enter ()
- (if (eq (sb-thread:mutex-value *global-lock*) sb-thread:*current-thread*)
- (incf recursive-level)
- (sb-thread:get-mutex *global-lock*)))
-
- (defun threads-leave (&optional flush-p)
- (cond
- ((zerop recursive-level)
- (when flush-p
- (display-flush))
- (sb-thread:release-mutex *global-lock*))
- (t (decf recursive-level)))))
+
+ (defun %global-lock-p ()
+ (eq (car (sb-thread:mutex-value *global-lock*)) sb-thread:*current-thread*))
+
+ (defun threads-enter ()
+ (if (%global-lock-p)
+ (incf (cdr (sb-thread:mutex-value *global-lock*)))
+ (sb-thread:get-mutex *global-lock* (cons sb-thread:*current-thread* 0))))
+
+ (defun threads-leave (&optional flush-p)
+ (assert (%global-lock-p))
+ (cond
+ ((zerop (cdr (sb-thread:mutex-value *global-lock*)))
+ (when flush-p
+ (flush))
+ (sb-thread:release-mutex *global-lock*))
+ (t (decf (cdr (sb-thread:mutex-value *global-lock*))))))