Changeset 12970


Ignore:
Timestamp:
Oct 9, 2009, 8:27:57 PM (10 years ago)
Author:
gz
Message:

Safer string-output-stream-ioblock recycling (r12842)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/l1-streams.lisp

    r12966 r12970  
    42334233
    42344234(defstruct (string-output-stream-ioblock (:include string-stream-ioblock))
    4235   (index 0))
     4235  (index 0)
     4236  freelist)
    42364237
    42374238(defstatic *string-output-stream-class* (make-built-in-class 'string-output-stream 'string-stream 'basic-character-output-stream))
     
    42544255;;; *string-output-stream-class*
    42554256(defun %close-string-output-stream (stream ioblock)
    4256   (when (eq (basic-stream.wrapper stream)
    4257             *string-output-stream-class-wrapper*)
     4257  (let* ((pool %string-output-stream-ioblocks%))
     4258    (when (and pool
     4259               (eq (basic-stream.wrapper stream)
     4260                   *string-output-stream-class-wrapper*)
     4261               (eq (string-output-stream-ioblock-freelist ioblock) pool))
    42584262    (without-interrupts
    4259      (setf (ioblock-stream ioblock) (pool.data %string-output-stream-ioblocks%)
    4260            (pool.data %string-output-stream-ioblocks%) ioblock))))
     4263     (setf (ioblock-stream ioblock) (pool.data pool)
     4264           (pool.data pool) ioblock)))))
     4265
     4266;;; If this is the sort of string stream whose ioblock we recycle and
     4267;;; there's a thread-local binding of the variable we use for a freelist,
     4268;;; return the value of that binding.
     4269(defun %string-stream-ioblock-freelist (stream)
     4270  (and stream
     4271       (eq (basic-stream.wrapper stream)
     4272           *string-output-stream-class-wrapper*)
     4273       (let* ((loc (%tcr-binding-location (%current-tcr) '%string-output-stream-ioblocks%)))
     4274         (and loc (%fixnum-ref loc)))))
     4275
    42614276
    42624277(defun create-string-output-stream-ioblock (&rest keys &key stream &allow-other-keys)
     
    42904305                     :write-simple-string-function write-string-function
    42914306                     :force-output-function #'false
     4307                     :freelist (%string-stream-ioblock-freelist stream)
    42924308                     :close-function #'%close-string-output-stream)))
    42934309      (setf (basic-stream.state stream) ioblock)
Note: See TracChangeset for help on using the changeset viewer.