From: Gabor Melis <mega@hotpop.com>
Date: Thu, 4 Aug 2005 13:05:30 +0000 (+0000)
Subject: 0.9.3.28: bdowning's fd-stream patch, slightly modified
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=22c2a90d020bb49fe25c653820ee4feea277b900;p=sbcl.git

0.9.3.28: bdowning's fd-stream patch, slightly modified
  * *AVAILABLE-BUFFERS* is now shared between threads to avoid
    leaking 8192 bytes per stream created in one thread but
    written to in another
  * killed two warnings introduced in purify.c
---

diff --git a/NEWS b/NEWS
index 4a3b2b9..b42c442 100644
--- a/NEWS
+++ b/NEWS
@@ -20,8 +20,10 @@ changes in sbcl-0.9.4 relative to sbcl-0.9.3:
     *DEBUGGER-HOOK* => *DEBUGGER-HOOK* is not run when the debugger
     is disabled.
   * threads
-    ** bug fix: release-foreground doesn't choke on session lock if
+    ** bug fix: RELEASE-FOREGROUND doesn't choke on session lock if
        there is only one thread in the session
+    ** bug fix: memory leak for streams created in one thread and
+       written to in another
 
 changes in sbcl-0.9.3 relative to sbcl-0.9.2:
   * New feature: Experimental support for bivalent streams: streams
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 122809f..1d98e0e 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -20,6 +20,20 @@
   "List of available buffers. Each buffer is an sap pointing to
   bytes-per-buffer of memory.")
 
+#!+sb-thread
+(defvar *available-buffers-mutex* (sb!thread:make-mutex
+                                   :name "lock for *AVAILABLE-BUFFERS*")
+  #!+sb-doc
+  "Mutex for access to *AVAILABLE-BUFFERS*.")
+
+(defmacro with-available-buffers-lock ((&optional) &body body)
+  ;; WITHOUT-INTERRUPTS because streams are low-level enough to be
+  ;; async signal safe, and in particular a C-c that brings up the
+  ;; debugger while holding the mutex would lose badly
+  `(without-interrupts
+    (sb!thread:with-mutex (*available-buffers-mutex*)
+      ,@body)))
+
 (defconstant bytes-per-buffer (* 4 1024)
   #!+sb-doc
   "Number of bytes per buffer.")
@@ -27,9 +41,10 @@
 ;;; Return the next available buffer, creating one if necessary.
 #!-sb-fluid (declaim (inline next-available-buffer))
 (defun next-available-buffer ()
-  (if *available-buffers*
-      (pop *available-buffers*)
-      (allocate-system-memory bytes-per-buffer)))
+  (with-available-buffers-lock ()
+    (if *available-buffers*
+        (pop *available-buffers*)
+        (allocate-system-memory bytes-per-buffer))))
 
 ;;;; the FD-STREAM structure
 
@@ -177,7 +192,8 @@
                  (simple-stream-perror "couldn't write to ~S" stream errno)))
             ((eql count length) ; Hot damn, it worked.
              (when reuse-sap
-               (push base *available-buffers*)))
+               (with-available-buffers-lock ()
+                 (push base *available-buffers*))))
             ((not (null count)) ; sorta worked..
              (push (list base
                          (the index (+ start count))
@@ -1360,11 +1376,13 @@
 
     ;; drop buffers when direction changes
     (when (and (fd-stream-obuf-sap fd-stream) (not output-p))
-      (push (fd-stream-obuf-sap fd-stream) *available-buffers*)
-      (setf (fd-stream-obuf-sap fd-stream) nil))
+      (with-available-buffers-lock ()
+	(push (fd-stream-obuf-sap fd-stream) *available-buffers*)
+	(setf (fd-stream-obuf-sap fd-stream) nil)))
     (when (and (fd-stream-ibuf-sap fd-stream) (not input-p))
-      (push (fd-stream-ibuf-sap fd-stream) *available-buffers*)
-      (setf (fd-stream-ibuf-sap fd-stream) nil))
+      (with-available-buffers-lock ()
+	(push (fd-stream-ibuf-sap fd-stream) *available-buffers*)
+	(setf (fd-stream-ibuf-sap fd-stream) nil)))
     (when input-p
       (setf (fd-stream-ibuf-sap fd-stream) (next-available-buffer))
       (setf (fd-stream-ibuf-length fd-stream) bytes-per-buffer)
@@ -1571,11 +1589,13 @@
        (cancel-finalization fd-stream))
      (sb!unix:unix-close (fd-stream-fd fd-stream))
      (when (fd-stream-obuf-sap fd-stream)
-       (push (fd-stream-obuf-sap fd-stream) *available-buffers*)
-       (setf (fd-stream-obuf-sap fd-stream) nil))
+       (with-available-buffers-lock ()
+         (push (fd-stream-obuf-sap fd-stream) *available-buffers*)
+         (setf (fd-stream-obuf-sap fd-stream) nil)))
      (when (fd-stream-ibuf-sap fd-stream)
-       (push (fd-stream-ibuf-sap fd-stream) *available-buffers*)
-       (setf (fd-stream-ibuf-sap fd-stream) nil))
+       (with-available-buffers-lock ()
+         (push (fd-stream-ibuf-sap fd-stream) *available-buffers*)
+         (setf (fd-stream-ibuf-sap fd-stream) nil)))
      (sb!impl::set-closed-flame fd-stream))
     (:clear-input
      (setf (fd-stream-unread fd-stream) nil)
diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index b859ea7..918422f 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -486,8 +486,7 @@ returns the thread exits."
                     (sb!kernel::*restart-clusters* nil)
                     (sb!kernel::*handler-clusters* nil)
                     (sb!kernel::*condition-restarts* nil)
-                    (sb!impl::*descriptor-handlers* nil) ; serve-event
-                    (sb!impl::*available-buffers* nil)) ;for fd-stream
+                    (sb!impl::*descriptor-handlers* nil)) ; serve-event
                 ;; can't use handling-end-of-the-world, because that flushes
                 ;; output streams, and we don't necessarily have any (or we
                 ;; could be sharing them)
diff --git a/version.lisp-expr b/version.lisp-expr
index 641138d..febc033 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.3.27"
+"0.9.3.28"