Changeset 14397

Timestamp:

Nov 1, 2010, 4:28:33 PM (14 years ago)

Author:

Gary Byers

Message:

Try to make string-output-stream creation a little faster.
Amazingly enough, not creating a string-output-stream is still
faster than creating one is.

File:

• trunk/source/level-1/l1-streams.lisp (modified) (3 diffs)

trunk/source/level-1/l1-streams.lisp

@@ -4307 +4307 @@
                    *string-output-stream-class-wrapper*)
                (eq (string-output-stream-ioblock-freelist ioblock) pool))
-    (without-interrupts
-     (setf (ioblock-stream ioblock) (pool.data pool)
-           (pool.data pool) ioblock)))))
+      (without-interrupts
+       (setf (ioblock-stream ioblock) (pool.data pool)
+             (pool.data pool) ioblock)))))
 
 ;;; If this is the sort of string stream whose ioblock we recycle and
@@ -4322 +4322 @@
 
 
-(defun create-string-output-stream-ioblock (&rest keys &key stream &allow-other-keys)
-  (declare (dynamic-extent keys))
+(defun create-string-output-stream-ioblock (stream string write-char-function write-string-function)
   (let* ((recycled (and stream
                         (eq (basic-stream.wrapper stream)
@@ -4338 +4337 @@
                                    (string-output-stream-ioblock-line-length data) 80))
                            data)))))
-    (or recycled (apply #'make-string-output-stream-ioblock keys))))
+    (or recycled
+        (make-string-output-stream-ioblock :stream stream
+                                           :string string
+                                           :element-type 'character
+                                           :write-char-function write-char-function
+                                           :write-char-when-locked-function write-char-function
+                                           :write-simple-string-function write-string-function
+                                           :force-output-function #'false
+                                           :freelist (%string-stream-ioblock-freelist stream)
+                                           :close-function #'%close-string-output-stream
+                                           :device -1))))
                         
 
 
 (defun %%make-string-output-stream (class string write-char-function write-string-function)
-  (let* ((stream (allocate-basic-stream class)))
-    (initialize-basic-stream stream :element-type 'character)
-    (let* ((ioblock (create-string-output-stream-ioblock
-                     :stream stream
-                     :string string
-                     :element-type 'character
-                     :write-char-function write-char-function
-                     :write-char-when-locked-function write-char-function
-                     :write-simple-string-function write-string-function
-                     :force-output-function #'false
-                     :freelist (%string-stream-ioblock-freelist stream)
-                     :close-function #'%close-string-output-stream)))
+  (let* ((stream (gvector :basic-stream (%class.own-wrapper class)
+                          (logior (ash 1 basic-stream-flag.open-character)
+                                  (ash 1 basic-stream-flag.open-output))
+                          nil
+                          nil))
+         (ioblock (create-string-output-stream-ioblock stream string write-char-function write-string-function)))
       (setf (basic-stream.state stream) ioblock)
-      stream)))
+      stream))
 
 (declaim (inline %string-push-extend))