[slime-cvs] CVS slime
heller
heller at common-lisp.net
Tue Aug 5 17:38:45 UTC 2008
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv21228
Modified Files:
ChangeLog swank-backend.lisp swank-ecl.lisp swank-gray.lisp
swank-sbcl.lisp
Log Message:
Drop distinction between "recursive" and non-recursive locks.
* swank-backend.lisp (make-recursive-lock)
(call-with-recursive-lock-held): Deleted. Make the default locks
"recursive" instead.
--- /project/slime/cvsroot/slime/ChangeLog 2008/08/04 21:38:07 1.1391
+++ /project/slime/cvsroot/slime/ChangeLog 2008/08/05 17:38:44 1.1392
@@ -1,3 +1,14 @@
+2008-08-05 Helmut Eller <heller at common-lisp.net>
+
+ * swank-backend.lisp (make-recursive-lock)
+ (call-with-recursive-lock-held): Deleted. Make the default locks
+ "recursive" instead.
+
+ * swank-gray.lisp (stream-write-string): New method.
+
+ * swank-backend.lisp (*gray-stream-symbols*): Include
+ write-string.
+
2008-08-04 Helmut Eller <heller at common-lisp.net>
* swank-gray.lisp (slime-output-stream): Undo last change.
--- /project/slime/cvsroot/slime/swank-backend.lisp 2008/08/05 17:38:39 1.137
+++ /project/slime/cvsroot/slime/swank-backend.lisp 2008/08/05 17:38:44 1.138
@@ -969,7 +969,8 @@
(definterface make-lock (&key name)
"Make a lock for thread synchronization.
-Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time."
+Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time
+but that thread may hold it more than once."
(declare (ignore name))
:null-lock)
@@ -979,24 +980,6 @@
(type function function))
(funcall function))
-(definterface make-recursive-lock (&key name)
- "Make a lock for thread synchronization.
-Only one thread may hold the lock (via CALL-WITH-RECURSIVE-LOCK-HELD)
-at a time, but that thread may hold it more than once."
- (cons nil (make-lock :name name)))
-
-(definterface call-with-recursive-lock-held (lock function)
- "Call FUNCTION with LOCK held, queueing if necessary."
- (if (eql (car lock) (current-thread))
- (funcall function)
- (call-with-lock-held (cdr lock)
- (lambda ()
- (unwind-protect
- (progn
- (setf (car lock) (current-thread))
- (funcall function))
- (setf (car lock) nil))))))
-
(definterface current-thread ()
"Return the currently executing thread."
0)
--- /project/slime/cvsroot/slime/swank-ecl.lisp 2008/05/08 22:55:02 1.23
+++ /project/slime/cvsroot/slime/swank-ecl.lisp 2008/08/05 17:38:44 1.24
@@ -487,13 +487,6 @@
(declare (type function function))
(mp:with-lock (lock) (funcall function)))
- (defimplementation make-recursive-lock (&key name)
- (mp:make-lock :name name))
-
- (defimplementation call-with-recursive-lock-held (lock function)
- (declare (type function function))
- (mp:with-lock (lock) (funcall function)))
-
(defimplementation current-thread ()
mp:*current-process*)
@@ -549,38 +542,34 @@
"How often to flush interactive streams. This valu is passed
directly to cl:sleep.")
- (defvar *auto-flush-lock* (make-recursive-lock :name "auto flush"))
+ (defvar *auto-flush-lock* (make-lock :name "auto flush"))
(defvar *auto-flush-thread* nil)
(defvar *auto-flush-streams* '())
(defimplementation make-stream-interactive (stream)
- (call-with-recursive-lock-held
- *auto-flush-lock*
- (lambda ()
- (pushnew stream *auto-flush-streams*)
- (unless *auto-flush-thread*
- (setq *auto-flush-thread*
- (spawn #'flush-streams
- :name "auto-flush-thread"))))))
+ (mp:with-lock (*auto-flush-lock*)
+ (pushnew stream *auto-flush-streams*)
+ (unless *auto-flush-thread*
+ (setq *auto-flush-thread*
+ (spawn #'flush-streams
+ :name "auto-flush-thread")))))
(defmethod stream-finish-output ((stream stream))
(finish-output stream))
(defun flush-streams ()
(loop
- (call-with-recursive-lock-held
- *auto-flush-lock*
- (lambda ()
- (setq *auto-flush-streams*
- (remove-if (lambda (x)
- (not (and (open-stream-p x)
- (output-stream-p x))))
- *auto-flush-streams*))
- (dolist (i *auto-flush-streams*)
- (ignore-errors (stream-finish-output i))
- (ignore-errors (finish-output i)))))
+ (mp:with-lock (*auto-flush-lock*)
+ (setq *auto-flush-streams*
+ (remove-if (lambda (x)
+ (not (and (open-stream-p x)
+ (output-stream-p x))))
+ *auto-flush-streams*))
+ (dolist (i *auto-flush-streams*)
+ (ignore-errors (stream-finish-output i))
+ (ignore-errors (finish-output i))))
(sleep *auto-flush-interval*)))
)
--- /project/slime/cvsroot/slime/swank-gray.lisp 2008/08/05 17:38:40 1.13
+++ /project/slime/cvsroot/slime/swank-gray.lisp 2008/08/05 17:38:44 1.14
@@ -15,11 +15,11 @@
(buffer :initform (make-string 8000))
(fill-pointer :initform 0)
(column :initform 0)
- (lock :initform (make-recursive-lock :name "buffer write lock"))))
+ (lock :initform (make-lock :name "buffer write lock"))))
(defmacro with-slime-output-stream (stream &body body)
`(with-slots (lock output-fn buffer fill-pointer column) ,stream
- (call-with-recursive-lock-held lock (lambda () , at body))))
+ (call-with-lock-held lock (lambda () , at body))))
(defmethod stream-write-char ((stream slime-output-stream) char)
(with-slime-output-stream stream
--- /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/08/04 21:38:07 1.204
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/08/05 17:38:44 1.205
@@ -1235,13 +1235,6 @@
(defimplementation call-with-lock-held (lock function)
(declare (type function function))
- (sb-thread:with-mutex (lock) (funcall function)))
-
- (defimplementation make-recursive-lock (&key name)
- (sb-thread:make-mutex :name name))
-
- (defimplementation call-with-recursive-lock-held (lock function)
- (declare (type function function))
(sb-thread:with-recursive-lock (lock) (funcall function)))
(defimplementation current-thread ()
@@ -1314,33 +1307,29 @@
"How often to flush interactive streams. This value is passed
directly to cl:sleep.")
- (defvar *auto-flush-lock* (make-recursive-lock :name "auto flush"))
+ (defvar *auto-flush-lock* (sb-thread:make-mutex :name "auto flush"))
(defvar *auto-flush-thread* nil)
(defvar *auto-flush-streams* '())
(defimplementation make-stream-interactive (stream)
- (call-with-recursive-lock-held
- *auto-flush-lock*
- (lambda ()
- (pushnew stream *auto-flush-streams*)
- (unless *auto-flush-thread*
- (setq *auto-flush-thread*
- (sb-thread:make-thread #'flush-streams
- :name "auto-flush-thread"))))))
+ (sb-thread:with-mutex (*auto-flush-lock*)
+ (pushnew stream *auto-flush-streams*)
+ (unless *auto-flush-thread*
+ (setq *auto-flush-thread*
+ (sb-thread:make-thread #'flush-streams
+ :name "auto-flush-thread")))))
(defun flush-streams ()
(loop
- (call-with-recursive-lock-held
- *auto-flush-lock*
- (lambda ()
- (setq *auto-flush-streams*
- (remove-if (lambda (x)
- (not (and (open-stream-p x)
- (output-stream-p x))))
- *auto-flush-streams*))
- (mapc #'finish-output *auto-flush-streams*)))
+ (sb-thread:with-mutex (*auto-flush-lock*)
+ (setq *auto-flush-streams*
+ (remove-if (lambda (x)
+ (not (and (open-stream-p x)
+ (output-stream-p x))))
+ *auto-flush-streams*))
+ (mapc #'finish-output *auto-flush-streams*))
(sleep *auto-flush-interval*)))
)
More information about the slime-cvs
mailing list