X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffd-stream.lisp;h=37ae9970891173ced318e34db34a71c53ca29547;hb=ef716ee5409d0d55020aea422e29a9175c2b4b74;hp=50665f71ade5bf802a743e012888928b6064dd6e;hpb=c548f73e8dd676d6ec4576eba6ab661a5061bdfe;p=sbcl.git

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 50665f7..37ae997 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -18,9 +18,8 @@
 (defvar *available-buffers* ()
   #!+sb-doc
   "List of available buffers. Each buffer is an sap pointing to
-  bytes-per-buffer of memory.")
+bytes-per-buffer of memory.")
 
-#!+sb-thread
 (defvar *available-buffers-mutex* (sb!thread:make-mutex
                                    :name "lock for *AVAILABLE-BUFFERS*")
   #!+sb-doc
@@ -220,7 +219,8 @@
             ((not (null count)) ; sorta worked..
              (push (list base
                          (the index (+ start count))
-                         end)
+                         end
+                         reuse-sap)
                    (fd-stream-output-later stream))))))
   (unless (fd-stream-output-later stream)
     (remove-fd-handler (fd-stream-handler stream))
@@ -1228,26 +1228,22 @@
             (let* ((length (length string))
                    (,n-buffer (make-array (* (1+ length) ,size)
                                           :element-type '(unsigned-byte 8)))
-                   ;; This SAP-taking may seem unsafe without pinning,
-                   ;; but since the variable name is a gensym OUT-EXPR
-                   ;; cannot close over it even if it tried, so the buffer
-                   ;; will always be either in a register or on stack.
-                   ;; FIXME: But ...this is true on x86oids only!
-                   (sap (vector-sap ,n-buffer))
                    (tail 0)
                    (stream ,name))
-              (declare (type index length tail)
-                       (type system-area-pointer sap))
-              (dotimes (i length)
-                (let* ((byte (aref string i))
-                       (bits (char-code byte)))
-                  (declare (ignorable byte bits))
-                  ,out-expr)
-                (incf tail ,size))
-              (let* ((bits 0)
-                     (byte (code-char bits)))
-                (declare (ignorable bits byte))
-                ,out-expr)
+              (declare (type index length tail))
+              (with-pinned-objects (,n-buffer)
+                (let ((sap (vector-sap ,n-buffer)))
+                  (declare (system-area-pointer sap))
+                  (dotimes (i length)
+                    (let* ((byte (aref string i))
+                           (bits (char-code byte)))
+                      (declare (ignorable byte bits))
+                      ,out-expr)
+                    (incf tail ,size))
+                  (let* ((bits 0)
+                         (byte (code-char bits)))
+                    (declare (ignorable bits byte))
+                    ,out-expr)))
               ,n-buffer)))
       (setf *external-formats*
        (cons '(,external-format ,in-function ,in-char-function ,out-function
@@ -1480,29 +1476,25 @@
                  (tail 0)
                  (,n-buffer (make-array buffer-length
                                         :element-type '(unsigned-byte 8)))
-                 ;; This SAP-taking may seem unsafe without pinning,
-                 ;; but since the variable name is a gensym OUT-EXPR
-                 ;; cannot close over it even if it tried, so the buffer
-                 ;; will always be either in a register or on stack.
-                 ;; FIXME: But ...this is true on x86oids only!
-                 (sap (vector-sap ,n-buffer))
                  stream)
             (declare (type index length buffer-length tail)
-                     (type system-area-pointer sap)
                      (type null stream)
                      (ignorable stream))
-            (loop for i of-type index below length
-                  for byte of-type character = (aref string i)
-                  for bits = (char-code byte)
-                  for size of-type index = (aref char-length i)
-                  do (prog1
-                         ,out-expr
-                       (incf tail size)))
-            (let* ((bits 0)
-                   (byte (code-char bits))
-                   (size (aref char-length length)))
-              (declare (ignorable bits byte size))
-              ,out-expr)
+            (with-pinned-objects (,n-buffer)
+              (let ((sap (vector-sap ,n-buffer)))
+                (declare (system-area-pointer sap))
+                (loop for i of-type index below length
+                      for byte of-type character = (aref string i)
+                      for bits = (char-code byte)
+                      for size of-type index = (aref char-length i)
+                      do (prog1
+                             ,out-expr
+                           (incf tail size)))
+                (let* ((bits 0)
+                       (byte (code-char bits))
+                       (size (aref char-length length)))
+                  (declare (ignorable bits byte size))
+                  ,out-expr)))
             ,n-buffer)))
 
       (setf *external-formats*