Changeset 9831


Ignore:
Timestamp:
Jun 26, 2008, 9:54:49 PM (11 years ago)
Author:
gb
Message:

Make CLOSE of shared ioblock-based streams thread-safe:

  • CLOSE (actually, %IOBLOCK-CLOSE) waits for all buffer locks and sets ioblock.device to NIL, does nothing if already NIL.
  • Any other function that waits for ioblock locks checks ioblock.device and signals STREAM-IS-CLOSED error if it's NIL
  • string-streams set ioblock.device to -1 (the default value) when open, follow the same protocol for close. (String-streams are generally implicitly thread-private, but it seems safest to use the same conventions.)
  • Add code to close ioblock-based streams before saving an image, tweak it to observe ioblock.device conventions.
  • Remove a few unused ioblock-lock macros, enforce the check for closed-while-waiting in other macros
  • Since CLOSE now does ownership checks, make stream finalization use CLOSE-FOR-TERMINATION, which (since it's only called when the stream isn't otherwise referenced) can clobber ioblock.owner before doing the CLOSE.

This code (modulo any remaining bugs) should go into 1.2 and other
working branches.

I don't -think- that it's hard to bootstrap, but it's important
to do a full rebuild after svn update.

Location:
trunk/source
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-streams.lisp

    r9731 r9831  
    314314  (open-stream-p stream))
    315315
     316(defmethod close-for-termination ((stream stream) abort)
     317  (close stream :abort abort))
    316318
    317319
     
    24902492          (decf need avail))))))
    24912493
    2492 (defun %ioblock-close (ioblock)
    2493   (let* ((stream (ioblock-stream ioblock)))
     2494;;; Thread must own ioblock lock(s).
     2495(defun %%ioblock-close (ioblock)
     2496  (when (ioblock-device ioblock)
     2497    (let* ((stream (ioblock-stream ioblock)))
    24942498      (funcall (ioblock-close-function ioblock) stream ioblock)
     2499      (setf (ioblock-device ioblock) nil)
    24952500      (setf (stream-ioblock stream) nil)
    24962501      (let* ((in-iobuf (ioblock-inbuf ioblock))
     
    25122517          (setf (io-buffer-buffer out-iobuf) nil
    25132518                (io-buffer-bufptr out-iobuf) nil
    2514                 (ioblock-outbuf ioblock) nil)))))
     2519                (ioblock-outbuf ioblock) nil))
     2520        t))))
     2521
     2522(defun %ioblock-close (ioblock)
     2523  (let* ((in-lock (ioblock-inbuf-lock ioblock))
     2524         (out-lock (ioblock-outbuf-lock ioblock)))
     2525    (if in-lock
     2526      (with-lock-grabbed (in-lock)
     2527        (if (and out-lock (not (eq out-lock in-lock)))
     2528          (with-lock-grabbed (out-lock)
     2529            (%%ioblock-close ioblock))
     2530          (%%ioblock-close ioblock)))
     2531      (if out-lock
     2532        (with-lock-grabbed (out-lock)
     2533          (%%ioblock-close ioblock))
     2534        (progn
     2535          (check-ioblock-owner ioblock)
     2536          (%%ioblock-close ioblock))))))
    25152537
    25162538
     
    33593381        (terminate-when-unreachable stream
    33603382                                    (lambda (stream)
    3361                                       (close stream :abort t))))
     3383                                      (close-for-termination stream t))))
    33623384      stream)))
    33633385
     
    42424264                                   (ioblock-stream data)
    42434265                                   (ioblock-stream data) stream
     4266                                   (ioblock-device data) -1
    42444267                                   (ioblock-charpos data) 0
    42454268                                   (string-output-stream-ioblock-index data) 0))
     
    42544277    (let* ((ioblock (create-string-output-stream-ioblock
    42554278                     :stream stream
    4256                      :device nil
    42574279                     :string string
    42584280                     :element-type 'character
     
    46744696                     :stream stream
    46754697                     :offset offset
    4676                      :device nil
    46774698                     :string data
    46784699                     :start start
     
    47964817      (%ioblock-close ioblock))))
    47974818
     4819
    47984820(defmethod close :before ((stream buffered-output-stream-mixin) &key abort)
    47994821  (unless abort
    48004822    (when (open-stream-p stream)
    48014823      (stream-force-output stream))))
     4824
     4825(defmethod close-for-termination ((stream buffered-output-stream-mixin) abort)
     4826  ;; This method should only be invoked via the termination mechanism,
     4827  ;; so it can safely assume that there's no contention for the stream.
     4828  (let* ((ioblock (stream-ioblock stream nil)))
     4829    (when ioblock (setf (ioblock-owner ioblock) nil)))
     4830  (close stream :abort abort))
     4831
    48024832
    48034833(defmethod interactive-stream-p ((stream buffered-stream-mixin))
     
    48124842      (%ioblock-close ioblock))))
    48134843
     4844(defmethod close-for-termination  ((stream basic-stream) abort)
     4845  (let* ((ioblock (basic-stream.state stream)))
     4846    (when ioblock (setf (ioblock-owner ioblock) nil)))
     4847  (close stream :abort abort))
     4848
     4849 
    48144850
    48154851(defmethod open-stream-p ((stream basic-stream))
     
    54755511  (cancel-terminate-when-unreachable s)
    54765512  (when (ioblock-dirty ioblock)
    5477     (stream-finish-output s))
     5513    (stream-force-output s))
    54785514  (let* ((fd (ioblock-device ioblock)))
    54795515    (when fd
    54805516      (setf (ioblock-device ioblock) nil)
    5481       (fd-close fd))))
     5517      (if (>= fd 0) (fd-close fd)))))
    54825518
    54835519(defun fd-stream-force-output (s ioblock count finish-p)
  • trunk/source/lib/dumplisp.lisp

    r8932 r9831  
    3939  )
    4040
     41(defun clear-ioblock-streams ()
     42  (%map-areas (lambda (o)
     43                (if (typep o 'basic-stream)
     44                  (let ((s (basic-stream.state o)))
     45                    (when (and (typep s 'ioblock)
     46                               (ioblock-device s)
     47                               (>= (ioblock-device s) 0))
     48                      (setf (basic-stream.state o) nil)))
     49                  (if (typep o 'buffered-stream-mixin)
     50                    (let ((s (slot-value o 'ioblock)))
     51                      (when (and (typep s 'ioblock)
     52                                 (ioblock-device s)
     53                                 (>= (ioblock-device s) 0))
     54                        (setf (slot-value o 'ioblock) nil))))))))
    4155
    4256(defun save-application (filename
     
    117131                           (funcall f))
    118132                         (kill-lisp-pointers)
     133                         (clear-ioblock-streams)
    119134                         (%set-toplevel
    120135                          #'(lambda ()
  • trunk/source/lib/macros.lisp

    r9163 r9831  
    34453445(declare-arch-specific-macro area-succ)
    34463446
    3447 (defmacro with-ioblock-lock-grabbed ((lock)
    3448                                        &body body)
    3449   `(with-lock-grabbed (,lock)
    3450     ,@body))
    3451 
    3452 (defmacro with-ioblock-lock-grabbed-maybe ((lock)
    3453                                            &body body)
    3454   `(with-lock-grabbed-maybe (,lock)
    3455     ,@body))
     3447
    34563448
    34573449
     
    34683460
    34693461(defmacro with-ioblock-input-lock-grabbed ((ioblock) &body body)
    3470   `(with-lock-grabbed ((ioblock-inbuf-lock ,ioblock))
    3471     ,@body))
     3462  (let* ((i (gensym)))
     3463    `(let* ((,i ,ioblock))
     3464      (with-lock-grabbed ((ioblock-inbuf-lock ,i))
     3465        (cond ((ioblock-device ,i)
     3466               ,@body)
     3467              (t (stream-is-closed (ioblock-stream ,i))))))))
    34723468
    34733469(defmacro with-ioblock-output-lock-grabbed ((ioblock) &body body)
    3474   `(with-lock-grabbed ((ioblock-outbuf-lock ,ioblock))
    3475     ,@body))
     3470  (let* ((i (gensym)))
     3471    `(let* ((,i ,ioblock))
     3472      (with-lock-grabbed ((ioblock-outbuf-lock ,i))
     3473        (cond ((ioblock-device ,i)
     3474               ,@body)
     3475              (t (stream-is-closed (ioblock-stream ,i))))))))
    34763476 
    34773477
     
    35033503      (if ,lock
    35043504        (with-lock-grabbed (,lock)
    3505           ,@body)
     3505          (cond ((ioblock-device ,ioblock)
     3506                 ,@body)
     3507                (t (stream-is-closed (ioblock-stream ,ioblock)))))
    35063508        (progn
    35073509          (check-ioblock-owner ,ioblock)
     
    35143516      (if ,lock
    35153517        (with-lock-grabbed (,lock)
    3516           ,@body)
     3518          (cond ((ioblock-device ,ioblock)
     3519                 ,@body)
     3520                (t (stream-is-closed (ioblock-stream ,ioblock)))))
    35173521        (progn
    35183522          (check-ioblock-owner ,ioblock)
     
    35243528  (let* ((lock (gensym)))
    35253529    `(let* ((,lock (locally (declare (optimize (speed 3) (safety 0)))
    3526                                   (ioblock-outbuf-lock ,ioblock))))
     3530                     (ioblock-outbuf-lock ,ioblock))))
    35273531      (if ,lock
    3528         (with-lock-grabbed-maybe (,lock)
    3529           ,@body)
     3532        (with-lock-grabbed (,lock)
     3533          (cond ((ioblock-device ,ioblock)
     3534                 ,@body)
     3535                (t (stream-is-closed (ioblock-stream ,ioblock)))))
    35303536        (progn
    35313537          (check-ioblock-owner ,ioblock)
Note: See TracChangeset for help on using the changeset viewer.