Changeset 5212

Timestamp:

Sep 18, 2006, 11:36:30 PM (18 years ago)

Author:

Gary Byers

Message:

More changes; hard to bootstrap.

File:

• trunk/ccl/level-1/l1-streams.lisp (modified) (20 diffs)

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

@@ -372 +372 @@
   (encode-output-function nil)
   (decode-input-function nil)
-  (read-char-no-hang-function nil)
+  (read-char-when-locked-function nil)
   (write-simple-string-function 'ioblock-no-char-output)
   (character-read-vector-function 'ioblock-no-char-input)
   (read-line-function 'ioblock-no-char-input)
+  (write-char-when-locked-function nil)
+  (read-byte-when-locked-function nil)
+  (write-byte-when-locked-function nil)
+  (reserved1 nil)
+  (reserved2 nil)
   (reserved2 nil)
   (reserved3 nil))
@@ -512 +517 @@
             (io-buffer-buffer buf)) idx)))
 
+(defun %private-ioblock-read-s8-byte (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
+  (check-ioblock-owner ioblock)
+  (%ioblock-read-s8-byte ioblock))
+
+(defun %locked-ioblock-read-s8-byte (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
+  (with-ioblock-input-lock-grabbed (ioblock)
+    (%ioblock-read-s8-byte ioblock)))
+
+
 (declaim (inline %ioblock-read-u16-byte))
 (defun %ioblock-read-u16-byte (ioblock)
@@ -528 +544 @@
             (io-buffer-buffer buf)) idx)))
 
+(defun %private-ioblock-read-u16-byte (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
+  (check-ioblock-owner ioblock)
+  (%ioblock-read-u16-byte ioblock))
+
+(defun %locked-ioblock-read-u16-byte (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
+  (with-ioblock-input-lock-grabbed (ioblock)
+    (%ioblock-read-u16-byte ioblock)))
+
 (declaim (inline %ioblock-read-s16-byte))
 (defun %ioblock-read-s16-byte (ioblock)
@@ -544 +570 @@
             (io-buffer-buffer buf)) idx)))
 
+(defun %private-ioblock-read-s16-byte (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
+  (check-ioblock-owner ioblock)
+  (%ioblock-read-s16-byte ioblock))
+
+(defun %locked-ioblock-read-s16-byte (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
+  (with-ioblock-input-lock-grabbed (ioblock)
+    (%ioblock-read-s16-byte ioblock)))
+
+
 (declaim (inline %ioblock-read-u32-byte))
 (defun %ioblock-read-u32-byte (ioblock)
@@ -560 +597 @@
             (io-buffer-buffer buf)) idx)))
 
-(defun %private-ioblock-read-u16-byte (ioblock)
+(defun %private-ioblock-read-u32-byte (ioblock)
   (check-ioblock-owner ioblock)
-  (%ioblock-read-u16-byte ioblock))
-
-(defun %locked-ioblock-read-u16-byte (ioblock)
+  (%ioblock-read-u32-byte ioblock))
+
+(defun %locked-ioblock-read-u32-byte (ioblock)
+  (with-ioblock-input-lock-grabbed (ioblock)
+    (%ioblock-read-u32-byte ioblock)))
+
+(declaim (inline %ioblock-read-s32-byte))
+(defun %ioblock-read-s32-byte (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
+  (let* ((buf (ioblock-inbuf ioblock))
+         (idx (io-buffer-idx buf))
+         (limit (io-buffer-count buf)))
+    (declare (fixnum idx limit))
+    (when (= idx limit)
+      (unless (%ioblock-advance ioblock t)
+        (return-from %ioblock-read-s32-byte :eof))
+      (setq idx (io-buffer-idx buf)
+            limit (io-buffer-count buf)))
+    (setf (io-buffer-idx buf) (the fixnum (1+ idx)))
+    (aref (the (simple-array (signed-byte 32) (*))
+            (io-buffer-buffer buf)) idx)))
+
+(defun %private-ioblock-read-s32-byte (ioblock)
   (check-ioblock-owner ioblock)
-  (%ioblock-read-u16-byte ioblock))
-
+  (%ioblock-read-s32-byte ioblock))
+
+(defun %locked-ioblock-read-s32-byte (ioblock)
+  (with-ioblock-input-lock-grabbed (ioblock)
+    (%ioblock-read-s32-byte ioblock)))
+
+#+64-bit-target
+(progn
+(declaim (inline %ioblock-read-u64-byte))
+(defun %ioblock-read-u64-byte (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
+  (let* ((buf (ioblock-inbuf ioblock))
+         (idx (io-buffer-idx buf))
+         (limit (io-buffer-count buf)))
+    (declare (fixnum idx limit))
+    (when (= idx limit)
+      (unless (%ioblock-advance ioblock t)
+        (return-from %ioblock-read-u64-byte :eof))
+      (setq idx (io-buffer-idx buf)
+            limit (io-buffer-count buf)))
+    (setf (io-buffer-idx buf) (the fixnum (1+ idx)))
+    (aref (the (simple-array (unsigned-byte 64) (*))
+            (io-buffer-buffer buf)) idx)))
+
+(defun %private-ioblock-read-u64-byte (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
+  (check-ioblock-owner ioblock)
+  (%ioblock-read-u64-byte ioblock))
+
+(defun %locked-ioblock-read-u64-byte (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
+  (with-ioblock-input-lock-grabbed (ioblock)
+    (%ioblock-read-u64-byte ioblock)))
+
+(defun %ioblock-read-s64-byte (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
+  (let* ((buf (ioblock-inbuf ioblock))
+         (idx (io-buffer-idx buf))
+         (limit (io-buffer-count buf)))
+    (declare (fixnum idx limit))
+    (when (= idx limit)
+      (unless (%ioblock-advance ioblock t)
+        (return-from %ioblock-read-s64-byte :eof))
+      (setq idx (io-buffer-idx buf)
+            limit (io-buffer-count buf)))
+    (setf (io-buffer-idx buf) (the fixnum (1+ idx)))
+    (aref (the (simple-array (signed-byte 64) (*))
+            (io-buffer-buffer buf)) idx)))
+
+(defun %private-ioblock-read-s64-byte (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
+  (check-ioblock-owner ioblock)
+  (%ioblock-read-s64-byte ioblock))
+
+(defun %locked-ioblock-read-s64-byte (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
+  (with-ioblock-input-lock-grabbed (ioblock)
+    (%ioblock-read-s64-byte ioblock)))
+)
 
 (declaim (inline %ioblock-read-swapped-u16-byte))
@@ -611 +725 @@
   (declare (optimize (speed 3) (safety 0)))
   (check-ioblock-owner ioblock)
-  (let* ((buf (ioblock-inbuf ioblock))
-         (idx (io-buffer-idx buf))
-         (limit (io-buffer-count buf)))
-    (declare (fixnum idx limit))
-    (when (= idx limit)
-      (unless (%ioblock-advance ioblock t)
-        (return-from %private-ioblock-read-u8-byte :eof))
-      (setq idx (io-buffer-idx buf)
-            limit (io-buffer-count buf)))
-    (setf (io-buffer-idx buf) (the fixnum (1+ idx)))
-    (aref (the (simple-array (unsigned-byte 8) (*))
-            (io-buffer-buffer buf)) idx)))
+  (%ioblock-read-u8-byte ioblock))
 
 (defun %bivalent-locked-ioblock-read-u8-byte (ioblock)
@@ -646 +749 @@
 (defun %locked-ioblock-read-u8-byte (ioblock)
   (declare (optimize (speed 3) (safety 0)))
-  (with-ioblock-lock-grabbed ((locally (declare (optimize (speed 3) (safety 0)))
-                                (ioblock-inbuf-lock ioblock)))
-    (let* ((buf (ioblock-inbuf ioblock))
-           (idx (io-buffer-idx buf))
-           (limit (io-buffer-count buf)))
-      (declare (fixnum idx limit))
-      (when (= idx limit)
-        (unless (%ioblock-advance ioblock t)
-          (return-from %locked-ioblock-read-u8-byte :eof))
-        (setq idx (io-buffer-idx buf)
-              limit (io-buffer-count buf)))
-      (setf (io-buffer-idx buf) (the fixnum (1+ idx)))
-      (aref (the (simple-array (unsigned-byte 8) (*))
-              (io-buffer-buffer buf)) idx))))
+  (with-ioblock-input-lock-grabbed (ioblock)
+    (%ioblock-read-u8-byte ioblock)))
 
 (defun %general-ioblock-read-byte (ioblock)
@@ -704 +795 @@
 (defun %locked-ioblock-tyi (ioblock)
   (declare (optimize (speed 3) (safety 0)))
-  (with-ioblock-lock-grabbed ((locally (declare (optimize (speed 3) (safety 0)))
-                                (ioblock-inbuf-lock ioblock)))
+  (with-ioblock-input-lock-grabbed (ioblock)
     (%ioblock-tyi ioblock)))
 
@@ -766 +856 @@
 (defun %locked-ioblock-read-u16-encoded-char (ioblock)
   (declare (optimize (speed 3) (safety 0)))
-  (with-ioblock-input-locked (ioblock)
+  (with-ioblock-input-lock-grabbed (ioblock)
     (%ioblock-read-u16-encoded-char ioblock)))
 
@@ -973 +1063 @@
     element))
 
-(declaim (inline %ioblock-write-u16-element))
-(defun %ioblock-write-u16-element (ioblock element)
+(declaim (inline %ioblock-write-s8-element))
+(defun %ioblock-write-s8-element (ioblock element)
   (declare (optimize (speed 3) (safety 0)))
   (let* ((buf (ioblock-outbuf ioblock))
@@ -984 +1074 @@
       (%ioblock-force-output ioblock nil)
       (setq idx 0 count 0))
-    (setf (aref (the (simple-array (unsigned-byte 8) (*)) (io-buffer-buffer buf)) idx) element)
+    (setf (aref (the (simple-array (signed-byte 8) (*)) (io-buffer-buffer buf)) idx) element)
     (incf idx)
     (setf (io-buffer-idx buf) idx)
@@ -992 +1082 @@
     element))
 
+(declaim (inline %ioblock-write-u16-element))
+(defun %ioblock-write-u16-element (ioblock element)
+  (declare (optimize (speed 3) (safety 0)))
+  (let* ((buf (ioblock-outbuf ioblock))
+         (idx (io-buffer-idx buf))
+         (count (io-buffer-count buf))
+         (limit (io-buffer-limit buf)))
+    (declare (fixnum idx limit count))
+    (when (= idx limit)
+      (%ioblock-force-output ioblock nil)
+      (setq idx 0 count 0))
+    (setf (aref (the (simple-array (unsigned-byte 16) (*)) (io-buffer-buffer buf)) idx) element)
+    (incf idx)
+    (setf (io-buffer-idx buf) idx)
+    (when (> idx count)
+      (setf (io-buffer-count buf) idx))
+    (setf (ioblock-dirty ioblock) t)
+    element))
+
+(declaim (inline %ioblock-write-swapped-u16-element))
+(defun %ioblock-write-swapped-u16-element (ioblock element)
+  (declare (optimize (speed 3) (safety 0)))
+  (let* ((buf (ioblock-outbuf ioblock))
+         (idx (io-buffer-idx buf))
+         (count (io-buffer-count buf))
+         (limit (io-buffer-limit buf)))
+    (declare (fixnum idx limit count))
+    (when (= idx limit)
+      (%ioblock-force-output ioblock nil)
+      (setq idx 0 count 0))
+    (setf (aref (the (simple-array (unsigned-byte 16) (*))
+                  (io-buffer-buffer buf)) idx)
+          (logand #xffff (the fixnum (logior (the fixnum (ash element -8))
+                                             (the fixnum (ash element 8))))))
+    (incf idx)
+    (setf (io-buffer-idx buf) idx)
+    (when (> idx count)
+      (setf (io-buffer-count buf) idx))
+    (setf (ioblock-dirty ioblock) t)
+    element))
+
+(declaim (inline %ioblock-write-s16-element))
+(defun %ioblock-write-s16-element (ioblock element)
+  (declare (optimize (speed 3) (safety 0)))
+  (let* ((buf (ioblock-outbuf ioblock))
+         (idx (io-buffer-idx buf))
+         (count (io-buffer-count buf))
+         (limit (io-buffer-limit buf)))
+    (declare (fixnum idx limit count))
+    (when (= idx limit)
+      (%ioblock-force-output ioblock nil)
+      (setq idx 0 count 0))
+    (setf (aref (the (simple-array (signed-byte 16) (*)) (io-buffer-buffer buf)) idx) element)
+    (incf idx)
+    (setf (io-buffer-idx buf) idx)
+    (when (> idx count)
+      (setf (io-buffer-count buf) idx))
+    (setf (ioblock-dirty ioblock) t)
+    element))
+
+(declaim (inline %ioblock-write-u32-element))
+(defun %ioblock-write-u32-element (ioblock element)
+  (declare (optimize (speed 3) (safety 0)))
+  (let* ((buf (ioblock-outbuf ioblock))
+         (idx (io-buffer-idx buf))
+         (count (io-buffer-count buf))
+         (limit (io-buffer-limit buf)))
+    (declare (fixnum idx limit count))
+    (when (= idx limit)
+      (%ioblock-force-output ioblock nil)
+      (setq idx 0 count 0))
+    (setf (aref (the (simple-array (unsigned-byte 32) (*)) (io-buffer-buffer buf)) idx) element)
+    (incf idx)
+    (setf (io-buffer-idx buf) idx)
+    (when (> idx count)
+      (setf (io-buffer-count buf) idx))
+    (setf (ioblock-dirty ioblock) t)
+    element))
+
+(declaim (inline %ioblock-write-s32-element))
+(defun %ioblock-write-s32-element (ioblock element)
+  (declare (optimize (speed 3) (safety 0)))
+  (let* ((buf (ioblock-outbuf ioblock))
+         (idx (io-buffer-idx buf))
+         (count (io-buffer-count buf))
+         (limit (io-buffer-limit buf)))
+    (declare (fixnum idx limit count))
+    (when (= idx limit)
+      (%ioblock-force-output ioblock nil)
+      (setq idx 0 count 0))
+    (setf (aref (the (simple-array (signed-byte 32) (*)) (io-buffer-buffer buf)) idx) element)
+    (incf idx)
+    (setf (io-buffer-idx buf) idx)
+    (when (> idx count)
+      (setf (io-buffer-count buf) idx))
+    (setf (ioblock-dirty ioblock) t)
+    element))
+
+#+64-bit-target
+(progn
+(declaim (inline %ioblock-write-u64-element))
+(defun %ioblock-write-u64-element (ioblock element)
+  (declare (optimize (speed 3) (safety 0)))
+  (let* ((buf (ioblock-outbuf ioblock))
+         (idx (io-buffer-idx buf))
+         (count (io-buffer-count buf))
+         (limit (io-buffer-limit buf)))
+    (declare (fixnum idx limit count))
+    (when (= idx limit)
+      (%ioblock-force-output ioblock nil)
+      (setq idx 0 count 0))
+    (setf (aref (the (simple-array (unsigned-byte 64) (*)) (io-buffer-buffer buf)) idx) element)
+    (incf idx)
+    (setf (io-buffer-idx buf) idx)
+    (when (> idx count)
+      (setf (io-buffer-count buf) idx))
+    (setf (ioblock-dirty ioblock) t)
+    element))
+
+(declaim (inline %ioblock-write-s64-element))
+(defun %ioblock-write-s64-element (ioblock element)
+  (declare (optimize (speed 3) (safety 0)))
+  (let* ((buf (ioblock-outbuf ioblock))
+         (idx (io-buffer-idx buf))
+         (count (io-buffer-count buf))
+         (limit (io-buffer-limit buf)))
+    (declare (fixnum idx limit count))
+    (when (= idx limit)
+      (%ioblock-force-output ioblock nil)
+      (setq idx 0 count 0))
+    (setf (aref (the (simple-array (signed-byte 64) (*)) (io-buffer-buffer buf)) idx) element)
+    (incf idx)
+    (setf (io-buffer-idx buf) idx)
+    (when (> idx count)
+      (setf (io-buffer-count buf) idx))
+    (setf (ioblock-dirty ioblock) t)
+    element))
+)
 
 (declaim (inline %ioblock-write-char))
@@ -1012 +1240 @@
 (defun %locked-ioblock-write-char (ioblock char)
   (declare (optimize (speed 3) (safety 0)))
-  (with-ioblock-input-locked (ioblock)
+  (with-ioblock-output-lock-grabbed (ioblock)
     (%ioblock-write-char ioblock char)))
 
@@ -1037 +1265 @@
 (defun %locked-ioblock-write-u8-encoded-char (ioblock char)
   (declare (optimize (speed 3) (safety 0)))
-  (with-ioblock-output-locked (ioblock) 
+  (with-ioblock-output-lock-grabbed (ioblock) 
     (%ioblock-write-u8-encoded-char ioblock char)))
 
@@ -1062 +1290 @@
         (funcall encode-function char #'%ioblock-write-u8-element ioblock)))))
 
+(declaim (inline %ioblock-write-u8-byte))
 (defun %ioblock-write-u8-byte (ioblock byte)
   (declare (optimize (speed 3) (safety 0)))
   (if (= byte (logand #xff byte))
     (%ioblock-write-u8-element ioblock byte)
-    (error "Can't write ~s to stream ~s". (byte (ioblock-stream ioblock)))))
-
-  
+    (error "~s doesn't match stream element-type of ~s". (byte (ioblock-stream ioblock)))))
+
+(defun %private-ioblock-write-u8-byte (ioblock byte)
+  (declare (optimize (speed 3) (safety 0)))
+  (check-ioblock-owner ioblock)
+  (%ioblock-write-u8-byte ioblock byte))
+
+(defun %locked-ioblock-write-u8-byte (ioblock byte)
+  (declare (optimize (speed 3) (safety 0)))
+  (with-ioblock-output-lock-grabbed (ioblock)
+    (%ioblock-write-u8-byte ioblock byte)))
+
+(declaim (inline %ioblock-write-s8-byte))
+(defun %ioblock-write-s8-byte (ioblock byte)
+  (declare (optimize (speed 3) (safety 0)))
+  (if (and (typep byte 'fixnum)
+           (>= (the fixnum byte) -128)
+           (< (the fixnum byte) 128))
+    (%ioblock-write-s8-element ioblock byte)
+    (error "~s doesn't match stream element-type of ~s". (byte (ioblock-stream ioblock)))))
+
+(defun %private-ioblock-write-s8-byte (ioblock byte)
+  (declare (optimize (speed 3) (safety 0)))
+  (check-ioblock-owner ioblock)
+  (%ioblock-write-s8-byte ioblock byte))
+
+(defun %locked-ioblock-write-s8-byte (ioblock byte)
+  (declare (optimize (speed 3) (safety 0)))
+  (with-ioblock-output-lock-grabbed (ioblock)
+    (%ioblock-write-s8-byte ioblock byte)))
+
+(declaim (inline %ioblock-write-u16-byte))
+(defun %ioblock-write-u16-byte (ioblock byte)
+  (declare (optimize (speed 3) (safety 0)))
+  (if (= byte (logand #xffff byte))
+    (%ioblock-write-u16-element ioblock byte)
+    (error "~s doesn't match stream element-type of ~s". (byte (ioblock-stream ioblock)))))
+
+(defun %private-ioblock-write-u16-byte (ioblock byte)
+  (declare (optimize (speed 3) (safety 0)))
+  (check-ioblock-owner ioblock)
+  (%ioblock-write-u16-byte ioblock byte))
+
+(defun %locked-ioblock-write-u16-byte (ioblock byte)
+  (declare (optimize (speed 3) (safety 0)))
+  (with-ioblock-output-lock-grabbed (ioblock)
+    (%ioblock-write-u16-byte ioblock byte)))
+
+(declaim (inline %ioblock-write-s16-byte))
+(defun %ioblock-write-s16-byte (ioblock byte)
+  (declare (optimize (speed 3) (safety 0)))
+  (if (and (typep byte 'fixnum)
+           (>= (the fixnum byte) -32768)
+           (< (the fixnum byte) 32768))
+    (%ioblock-write-s16-element ioblock byte)
+    (error "~s doesn't match stream element-type of ~s". (byte (ioblock-stream ioblock)))))
+
+(defun %private-ioblock-write-s16-byte (ioblock byte)
+  (declare (optimize (speed 3) (safety 0)))
+  (check-ioblock-owner ioblock)
+  (%ioblock-write-s16-byte ioblock byte))
+
+(defun %locked-ioblock-write-s16-byte (ioblock byte)
+  (declare (optimize (speed 3) (safety 0)))
+  (with-ioblock-output-lock-grabbed (ioblock)
+    (%ioblock-write-s16-byte ioblock byte)))
+
+
+
 (defun %ioblock-clear-output (ioblock)
   (let* ((buf (ioblock-outbuf ioblock)))                      
@@ -1325 +1620 @@
                        (:lock '%locked-ioblock-read-u8-byte)
                        (t '%ioblock-read-u8-byte))))
+                  ((= subtag target::subtag-s8-vector)
+                     (case sharing
+                       (:private '%private-ioblock-read-s8-byte)
+                       (:lock '%locked-ioblock-read-s8-byte)
+                       (t '%ioblock-read-s8-byte)))
+                  ((= subtag target::subtag-u16-vector)
+                     (case sharing
+                       (:private '%private-ioblock-read-u16-byte)
+                       (:lock '%locked-ioblock-read-u16-byte)
+                       (t '%ioblock-read-u16-byte)))
+                  ((= subtag target::subtag-s16-vector)
+                     (case sharing
+                       (:private '%private-ioblock-read-s16-byte)
+                       (:lock '%locked-ioblock-read-s16-byte)
+                       (t '%ioblock-read-s16-byte)))
+                  ((= subtag target::subtag-u32-vector)
+                     (case sharing
+                       (:private '%private-ioblock-read-u32-byte)
+                       (:lock '%locked-ioblock-read-u32-byte)
+                       (t '%ioblock-read-u32-byte)))
+                  ((= subtag target::subtag-s32-vector)
+                     (case sharing
+                       (:private '%private-ioblock-read-s32-byte)
+                       (:lock '%locked-ioblock-read-s32-byte)
+                       (t '%ioblock-read-s32-byte)))
+                  #+64-bit-target
+                  ((= subtag target::subtag-u64-vector)
+                     (case sharing
+                       (:private '%private-ioblock-read-u64-byte)
+                       (:lock '%locked-ioblock-read-u64-byte)
+                       (t '%ioblock-read-u64-byte)))
+                  #+64-bit-target
+                  ((= subtag target::subtag-s64-vector)
+                     (case sharing
+                       (:private '%private-ioblock-read-s64-byte)
+                       (:lock '%locked-ioblock-read-s64-byte)
+                       (t '%ioblock-read-s64-byte)))
                   (t '%general-ioblock-read-byte))))))
 
@@ -1350 +1682 @@
                 (:private '%private-ioblock-write-char)
                 (:lock '%locked-ioblock-write-char)
-                (t '%ioblock-write-char)))))))
+                (t '%ioblock-write-char))))))
+  (unless (or (eq element-type 'character)
+              (subtypep element-type 'character))
+    (let* ((subtag (element-type-subtype element-type)))
+      (declare (type (unsigned-byte 8) subtag))
+      (setf (ioblock-write-byte-function ioblock)
+            (cond ((= subtag target::subtag-u8-vector)
+                   (if character-p
+                     ;; The bivalent case, at least for now
+                     (case sharing
+                       (:private '%bivalent-private-ioblock-write-u8-byte)
+                       (:lock '%bivalent-locked-ioblock-write-u8-byte)
+                       (t '%bivalent-ioblock-write-u8-byte))
+                     (case sharing
+                       (:private '%private-ioblock-write-u8-byte)
+                       (:lock '%locked-ioblock-write-u8-byte)
+                       (t '%ioblock-write-u8-byte))))
+                  ((= subtag target::subtag-s8-vector)
+                     (case sharing
+                       (:private '%private-ioblock-write-s8-byte)
+                       (:lock '%locked-ioblock-write-s8-byte)
+                       (t '%ioblock-write-s8-byte)))
+                  ((= subtag target::subtag-u16-vector)
+                     (case sharing
+                       (:private '%private-ioblock-write-u16-byte)
+                       (:lock '%locked-ioblock-write-u16-byte)
+                       (t '%ioblock-write-u16-byte)))
+                  ((= subtag target::subtag-s16-vector)
+                     (case sharing
+                       (:private '%private-ioblock-write-s16-byte)
+                       (:lock '%locked-ioblock-write-s16-byte)
+                       (t '%ioblock-write-s16-byte)))
+                  ((= subtag target::subtag-u32-vector)
+                     (case sharing
+                       (:private '%private-ioblock-write-u32-byte)
+                       (:lock '%locked-ioblock-write-u32-byte)
+                       (t '%ioblock-write-u32-byte)))
+                  ((= subtag target::subtag-s32-vector)
+                     (case sharing
+                       (:private '%private-ioblock-write-s32-byte)
+                       (:lock '%locked-ioblock-write-s32-byte)
+                       (t '%ioblock-write-s32-byte)))
+                  #+64-bit-target
+                  ((= subtag target::subtag-u64-vector)
+                     (case sharing
+                       (:private '%private-ioblock-write-u64-byte)
+                       (:lock '%locked-ioblock-write-u64-byte)
+                       (t '%ioblock-write-u64-byte)))
+                  #+64-bit-target
+                  ((= subtag target::subtag-s64-vector)
+                     (case sharing
+                       (:private '%private-ioblock-write-s64-byte)
+                       (:lock '%locked-ioblock-write-s64-byte)
+                       (t '%ioblock-write-s64-byte)))
+                  (t '%general-ioblock-write-byte))))))
 
 (defun buffer-element-type-for-character-encoding (encoding)
@@ -2732 +3118 @@
 (defmethod stream-write-byte ((stream buffered-binary-output-stream-mixin)
                               byte)
-  (with-stream-ioblock-output (ioblock stream :speedy t)
-    (%ioblock-write-byte ioblock byte)))
+  (let* ((ioblock (stream-ioblock stream t)))
+    (funcall (ioblock-write-byte-function ioblock) ioblock byte)))
 
 (defmethod stream-write-byte ((stream basic-binary-output-stream) byte)
   (let* ((ioblock (basic-stream-ioblock stream)))
-    (with-ioblock-output-locked (ioblock)
-      (%ioblock-write-byte ioblock byte))))
+    (funcall (ioblock-write-byte-function ioblock) ioblock byte)))
 
 (defmethod stream-write-char ((stream buffered-character-output-stream-mixin) char)
@@ -2913 +3298 @@
       (declare (fixnum buftype written total limit))
       (if (not (= (the fixnum (typecode vector)) buftype))
-        (do* ((i start (1+ i)))
+        (do* ((i start (1+ i))
+              (wbf (ioblock-write-byte-function ioblock)))
              ((= i end))
           (let ((byte (uvref vector i)))
             (when (characterp byte)
               (setq byte (char-code byte)))
-            (%ioblock-write-byte ioblock byte)))
+            (funcall wbf ioblock byte)))
         (do* ((pos start (+ pos written))
               (left total (- left written)))
@@ -2961 +3347 @@
       (declare (fixnum buftype written total limit))
       (if (not (= (the fixnum (typecode vector)) buftype))
-        (do* ((i start (1+ i)))
+        (do* ((i start (1+ i))
+              (wbf (ioblock-write-byte-function ioblock)))
              ((= i end))
           (let ((byte (uvref vector i)))
             (when (characterp byte)
               (setq byte (char-code byte)))
-            (%ioblock-write-byte ioblock byte)))
+            (funcall wbf ioblock byte)))
         (do* ((pos start (+ pos written))
               (left total (- left written)))