0.8.13.70: MORE DOCUMENTATION

[sbcl.git] / contrib / sb-simple-streams / strategy.lisp

diff --git a/contrib/sb-simple-streams/strategy.lisp b/contrib/sb-simple-streams/strategy.lisp
index ef74794..b080292 100644 (file)
--- a/contrib/sb-simple-streams/strategy.lisp
+++ b/contrib/sb-simple-streams/strategy.lisp
@@ -17,6 +17,7 @@
 ;;;; Helper functions
 
 (defun refill-buffer (stream blocking)
+  (declare (type blocking blocking))
   (with-stream-class (simple-stream stream)
     (let* ((unread (sm last-char-read-size stream))
            (buffer (sm buffer stream))
@@ -140,7 +141,8 @@
           (state (sm oc-state stream)))
       (flet ((input ()
               (when (>= buffpos (sm buffer-ptr stream))
-                 (when (sc-dirty-p stream)
+                 (when (and (not (any-stream-instance-flags stream :dual :string))
+                            (sc-dirty-p stream))
                    (flush-buffer stream t))
                 (let ((bytes (refill-buffer stream blocking)))
                   (cond ((= bytes 0)
@@ -216,7 +218,8 @@
            (type boolean blocking)
           #|(optimize (speed 3) (space 2) (safety 0) (debug 0))|#)
   (with-stream-class (simple-stream stream)
-    (when (sc-dirty-p stream)
+    (when (and (not (any-stream-instance-flags stream :dual :string))
+               (sc-dirty-p stream))
       (flush-buffer stream t))
     (do ((buffer (sm buffer stream))
          (buffpos (sm buffpos stream))
@@ -566,10 +569,10 @@
 ;;; function names), we make do with symbol frobbing.
 (defun %sf (kind name format &optional access)
   (flet ((find-strategy-function (&rest args)
-            (ignore-errors
-              (fdefinition (find-symbol (format nil "~{~A~^-~}"
-                                                (mapcar #'string args))
-                                        #.*package*)))))
+          (let ((name
+                 (find-symbol (format nil "~{~A~^-~}" (mapcar #'string args))
+                              #.*package*)))
+            (if (fboundp name) (fdefinition name) nil))))
     (or (find-strategy-function kind name format access)
         (find-strategy-function kind name format)
         (find-strategy-function kind name :ef access)