[Openmcl-cvs-notifications] r15292 - /trunk/source/level-1/l1-streams.lisp

[gb at clozure.com]

Author: gb
Date: Wed Apr  4 02:05:20 2012
New Revision: 15292

Log:
%ioblock-peek-char (the ISO-8859-1 version): if we don't get EOF,
we can safely decrement the input buffer idx by 1 (it'll always be
>=3D 1 after reading an octet.)

%encoded-ioblock-peek-char: (all other encodings): let the ioblock's
unread-char function decide how to handle unreading the character.
(FILE-STREAMs generally adjust the file's position, other kinds
of streams use IOBLOCK-UNTYI-CHAR, which confuses FILE-POSITION on
FILE-STREAMs.)

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

Modified: trunk/source/level-1/l1-streams.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-streams.lisp (original)
+++ trunk/source/level-1/l1-streams.lisp Wed Apr  4 02:05:20 2012
@@ -1375,22 +1375,21 @@
 ;;; :iso-8859-1 only.
 (defun %ioblock-peek-char (ioblock)
   (or (ioblock-untyi-char ioblock)
-      (let* ((buf (ioblock-inbuf ioblock))
-             (idx (io-buffer-idx buf))
-             (limit (io-buffer-count buf)))
-        (declare (fixnum idx limit))
-        (when (=3D idx limit)
-          (unless (%ioblock-advance ioblock t)
-            (return-from %ioblock-peek-char :eof))
-          (setq idx (io-buffer-idx buf)
-                limit (io-buffer-count buf)))
-        (%code-char (aref (the (simple-array (unsigned-byte 8) (*)) (io-bu=
ffer-buffer buf)) idx)))))
+      (let* ((b (%ioblock-read-u8-byte ioblock)))
+        (if (eq b :eof)
+          b
+          (let* ((ch (%code-char b))
+                 (buf (ioblock-inbuf ioblock))
+                 (idx (io-buffer-idx buf)))
+            (declare (fixnum idx))
+            (setf (io-buffer-idx buf) (the fixnum (1- idx)))
+            ch)))))
 =

 (defun %encoded-ioblock-peek-char (ioblock)
   (or (ioblock-untyi-char ioblock)
       (let* ((ch (funcall (ioblock-read-char-when-locked-function ioblock)=
 ioblock)))
         (unless (eq ch :eof)
-          (setf (ioblock-untyi-char ioblock) ch))
+          (funcall (ioblock-unread-char-function ioblock) ioblock ch))
         ch)))
 =

 =