[Openmcl-devel] string-output-stream thread unsafety with hunchentoot (ccl, darwin/x86-64)

[Gary Byers]

On Mon, 13 Apr 2009, Gail Zacharias wrote:

> On Thu, Apr 9, 2009 at 1:55 PM, Gary Byers <gb at clozure.com> wrote:
>> The assumptions in question are that:
>>  - string-output-streams are thread-private
>
> Would it slow them down too much to check for this, like
> thread-private file streams do?  I might be seeing a case of this
> (string output streams being passed across threads) and it would help
> to get an error right when it first happens.
>

It shouldn't be too bad to do that check, and enforcing thread-privacy
might also guard against other kinds of lossage.

The only downside that I can think of is that doing this - making
string-output-streams enforce their thread-privateness - might make
it difficult to create some sort of intentionally shared encapsulating
class (unless some way of clearing the owner info.)  I'm not sure
that that's much of a loss, and the whole notion of intentionally
passing string-output-streams around between threads seems kind of
ill-advised ...

In any case, I think that the changes in the enclosed patch are
all that'd be needed to enforce thread-privateness and they seem
to work; I'm a little hesitant to commit those changes without
testing it more than I have, but I -think- it's fair to say that the
cost of checking is pretty small.
-------------- next part --------------
Index: level-1/l1-streams.lisp
===================================================================
--- level-1/l1-streams.lisp	(revision 11875)
+++ level-1/l1-streams.lisp	(working copy)
@@ -4237,6 +4237,7 @@
 ;;; Should only be used for a stream whose class is exactly
 ;;; *string-output-stream-class* 
 (defun %close-string-output-stream (stream ioblock)
+  (check-ioblock-owner ioblock)
   (when (eq (basic-stream.wrapper stream)
             *string-output-stream-class-wrapper*)
     (without-interrupts
@@ -4258,7 +4259,7 @@
                                    (ioblock-charpos data) 0
                                    (string-output-stream-ioblock-index data) 0))
                            data)))))
-    (or recycled (apply #'make-string-output-stream-ioblock keys))))
+    (or recycled (apply #'make-string-output-stream-ioblock :owner *current-process* keys))))
                         
 
 
@@ -4329,6 +4330,7 @@
   (%%make-string-output-stream *fill-pointer-string-output-stream-class* string 'fill-pointer-string-output-stream-ioblock-write-char 'fill-pointer-string-output-stream-ioblock-write-simple-string))
 
 (defun string-output-stream-ioblock-write-char (ioblock char)
+  (check-ioblock-owner ioblock)
   (let* ((string (string-output-stream-ioblock-string ioblock))
          (index (string-output-stream-ioblock-index ioblock))
          (len (length string)))
@@ -4350,6 +4352,7 @@
   (declare (simple-string string)
            (fixnum start-char num-chars)
            (optimize (speed 3) (safety 0)))
+  (check-ioblock-owner ioblock)
   (let* ((out (string-output-stream-ioblock-string ioblock))
          (index (string-output-stream-ioblock-index ioblock))
          (len (length out))
@@ -4383,6 +4386,7 @@
 
 (defmethod stream-position ((stream string-output-stream) &optional newpos)
   (let* ((ioblock (basic-stream-ioblock stream)))
+    (check-ioblock-owner ioblock)
     (if (null newpos)
       (string-output-stream-ioblock-index ioblock)
       (if (and (typep newpos 'fixnum)