Changeset 5427

Timestamp:

Oct 25, 2006, 7:36:00 PM (18 years ago)

Author:

Gary Byers

Message:

%BIVALENT-IOBLOCK-READ-U8-BYTE (and variants): always clear the untyi-char.

%ENCODED-IOBLOCK-PEEK-CHAR: the read-char-when-locked function needs an argument.

SETUP-IOBLOCK-OUTPUT: there are no special output functions for bivalent streams.

%IOBLOCK-BINARY-READ-VECTOR: clear any untyi char.

File:

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

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

@@ -476 +476 @@
 (defun %bivalent-ioblock-read-u8-byte (ioblock)
   (declare (optimize (speed 3) (safety 0)))
-  (if (ioblock-untyi-char ioblock)
-    (setf (ioblock-untyi-char ioblock) nil))
+  (setf (ioblock-untyi-char ioblock) nil)
   (let* ((buf (ioblock-inbuf ioblock))
          (idx (io-buffer-idx buf))
@@ -1050 +1049 @@
   (declare (optimize (speed 3) (safety 0)))
   (check-ioblock-owner ioblock)
-  (if (ioblock-untyi-char ioblock)
-    (prog1 (%char-code (ioblock-untyi-char ioblock))
-      (setf (ioblock-untyi-char ioblock) nil))
+  (setf (ioblock-untyi-char ioblock) nil)
     (let* ((buf (ioblock-inbuf ioblock))
            (idx (io-buffer-idx buf))
@@ -1064 +1061 @@
       (setf (io-buffer-idx buf) (the fixnum (1+ idx)))
       (aref (the (simple-array (unsigned-byte 8) (*))
-              (io-buffer-buffer buf)) idx))))
+              (io-buffer-buffer buf)) idx)))
 
 (defun %private-ioblock-read-u8-byte (ioblock)
@@ -1074 +1071 @@
   (declare (optimize (speed 3) (safety 0)))
   (with-ioblock-input-lock-grabbed (ioblock)
-    (if (ioblock-untyi-char ioblock)
-      (prog1 (%char-code (ioblock-untyi-char ioblock))
-        (setf (ioblock-untyi-char ioblock) nil))
-      (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 %bivalent-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)))))
+    (setf (ioblock-untyi-char ioblock) nil)
+    (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 %bivalent-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))))
 
 (defun %locked-ioblock-read-u8-byte (ioblock)
@@ -1322 +1317 @@
 (defun %encoded-ioblock-peek-char (ioblock)
   (or (ioblock-untyi-char ioblock)
-      (let* ((ch (funcall (ioblock-read-char-when-locked-function ioblock))))
+      (let* ((ch (funcall (ioblock-read-char-when-locked-function ioblock) ioblock)))
         (unless (eq ch :eof)
           (setf (ioblock-untyi-char ioblock) ch))
@@ -2341 +2336 @@
          (inbuf (io-buffer-buffer in))
          (rbf (ioblock-read-byte-when-locked-function ioblock)))
+    (setf (ioblock-untyi-char ioblock) nil)
     (if (not (= (the fixnum (typecode inbuf))
                 (the fixnum (typecode vector))))
@@ -2417 +2413 @@
   (unless (= 0 (the fixnum (ioblock-element-shift ioblock)))
     (error "Can't read vector from stream ~s" (ioblock-stream ioblock)))
+  (setf (ioblock-untyi-char ioblock) nil)
   (do* ((i start)
         (rbf (ioblock-read-byte-when-locked-function ioblock))
@@ -2880 +2877 @@
       (setf (ioblock-write-byte-function ioblock)
             (cond ((= subtag target::subtag-u8-vector)
-                   (if character-p
-                     ;; The bivalent case, at least for now
-                     (progn
-                       (setf (ioblock-write-byte-when-locked-function ioblock)
-                             '%bivalent-ioblock-write-u8-byte)
-                       (case sharing
-                         (:private '%bivalent-private-ioblock-write-u8-byte)
-                         (:lock '%bivalent-locked-ioblock-write-u8-byte)
-                         (t '%bivalent-ioblock-write-u8-byte)))
-                     (progn
+                    (progn
                        (setf (ioblock-write-byte-when-locked-function ioblock)
                              '%ioblock-write-u8-byte)
@@ -2895 +2883 @@
                          (:private '%private-ioblock-write-u8-byte)
                          (:lock '%locked-ioblock-write-u8-byte)
-                         (t '%ioblock-write-u8-byte)))))
+                         (t '%ioblock-write-u8-byte))))
                   ((= subtag target::subtag-s8-vector)
                    (setf (ioblock-write-byte-when-locked-function ioblock)