Index: /trunk/ccl/level-1/l1-streams.lisp
===================================================================
--- /trunk/ccl/level-1/l1-streams.lisp	(revision 5244)
+++ /trunk/ccl/level-1/l1-streams.lisp	(revision 5245)
@@ -368,5 +368,5 @@
   (write-char-function 'ioblock-no-char-output)
   (encoding nil)
-  (alternate-line-termination nil)
+  (line-termination nil)
   (literal-char-code-limit 256)
   (encode-output-function nil)
@@ -379,8 +379,11 @@
   (read-byte-when-locked-function 'ioblock-no-binary-input)
   (write-byte-when-locked-function 'ioblock-no-binary-output)
+  (peek-char-function 'ioblock-no-char-input)
+  (input-filter #'false)
+  (output-filter #'false)
   (reserved1 nil)
   (reserved2 nil)
-  (reserved2 nil)
-  (reserved3 nil))
+  (reserved3 nil)
+  (reserved4 nil))
 
 
@@ -396,5 +399,5 @@
   (report-bad-arg (ioblock-stream ioblock) '(and binary-stream output-stream)))
 
-(defun ioblock-no-charr-input (ioblock &rest others)
+(defun ioblock-no-char-input (ioblock &rest others)
   (declare (ignore others))
   (report-bad-arg (ioblock-stream ioblock) '(and character-stream input-stream)))
@@ -816,5 +819,5 @@
   (%ioblock-read-u8-encoded-char ioblock))
 
-(defun %private-ioblock-read-u8-encoded-char (ioblock)
+(defun %locked-ioblock-read-u8-encoded-char (ioblock)
   (declare (optimize (speed 3) (safety 0)))
   (with-ioblock-input-locked (ioblock)
@@ -853,5 +856,4 @@
 
 (declaim (inline %ioblock-tyi-no-hang))
-
 (defun %ioblock-tyi-no-hang (ioblock)
   (declare (optimize (speed 3) (safety 0)))
@@ -865,11 +867,8 @@
       (when (= idx limit)
 	(unless (%ioblock-advance ioblock nil)
-	  (return-from %ioblock-tyi-no-hang (if (ioblock-eof ioblock) :eof)))
-	(setq idx (io-buffer-idx buf)
-	      limit (io-buffer-count buf)))
-      (setf (io-buffer-idx buf) (the fixnum (1+ idx)))
-      (%code-char (aref (the (simple-array (unsigned-byte 8) (*)) (io-buffer-buffer buf)) idx)))))
-
-
+	  (return-from %ioblock-tyi-no-hang (if (ioblock-eof ioblock) :eof))))
+      (funcall (ioblock-read-char-when-locked-function ioblock) ioblock))))
+
+;;; :iso-8859-1 only.
 (defun %ioblock-peek-char (ioblock)
   (or (ioblock-untyi-char ioblock)
@@ -885,4 +884,14 @@
         (%code-char (aref (the (simple-array (unsigned-byte 8) (*)) (io-buffer-buffer buf)) idx)))))
 
+(defun %encoded-ioblock-peek-char (ioblock)
+  (or (ioblock-untyi-char ioblock)
+      (let* ((ch (funcall (ioblock-read-char-when-locked-function ioblock))))
+        (unless (eq ch :eof)
+          (setf (ioblock-untyi-char ioblock) ch))
+        ch)))
+
+
+
+
 (defun %ioblock-clear-input (ioblock)    
     (let* ((buf (ioblock-inbuf ioblock)))
@@ -906,4 +915,88 @@
 (defun ioblock-outpos (ioblock)
   (io-buffer-count (ioblock-outbuf ioblock)))
+
+
+
+(defun u8-translate-cr-to-lf (vector n)
+  (declare (type (simple-array (unsigned-byte 8) (*)) vector)
+           (type index n)
+           (optimize (speed 3) (safety 0)))
+  (dotimes (i n t)
+    (if (= (the (unsigned-byte 8) (aref vector i)) (char-code #\Return))
+      (setf (aref vector i) (char-code #\Linefeed)))))
+
+(defun u8-translate-lf-to-cr (vector n)
+  (declare (type (simple-array (unsigned-byte 8) (*)) vector)
+           (type index n)
+           (optimize (speed 3) (safety 0)))
+  (dotimes (i n t)
+    (if (= (the (unsigned-byte 8) (aref vector i)) (char-code #\Linefeed))
+      (setf (aref vector i) (char-code #\Return)))))
+
+
+(defun u16-translate-cr-to-lf (vector n)
+  (declare (type (simple-array (unsigned-byte 16) (*)) vector)
+           (type index n)
+           (optimize (speed 3) (safety 0)))
+  (dotimes (i n t)
+    (if (= (the (unsigned-byte 16) (aref vector i)) (char-code #\Return))
+      (setf (aref vector i) (char-code #\Linefeed)))))
+
+(defun u16-translate-lf-to-cr (vector n)
+  (declare (type (simple-array (unsigned-byte 16) (*)) vector)
+           (type index n)
+           (optimize (speed 3) (safety 0)))
+  (dotimes (i n t)
+    (if (= (the (unsigned-byte 16) (aref vector i)) (char-code #\Linefeed))
+      (setf (aref vector i) (char-code #\Return)))))
+
+(defun u32-translate-cr-to-lf (vector n)
+  (declare (type (simple-array (unsigned-byte 32) (*)) vector)
+           (type index n)
+           (optimize (speed 3) (safety 0)))
+  (dotimes (i n t)
+    (if (= (the (unsigned-byte 32) (aref vector i)) (char-code #\Return))
+      (setf (aref vector i) (char-code #\Linefeed)))))
+
+(defun u32-translate-lf-to-cr (vector n)
+  (declare (type (simple-array (unsigned-byte 32) (*)) vector)
+           (type index n)
+           (optimize (speed 3) (safety 0)))
+  (dotimes (i n t)
+    (if (= (the (unsigned-byte 32) (aref vector i)) (char-code #\Linefeed))
+      (setf (aref vector i) (char-code #\Return)))))
+
+
+(defun swapped-u16-translate-cr-to-lf (vector n)
+  (declare (type (simple-array (unsigned-byte 16) (*)) vector)
+           (type index n)
+           (optimize (speed 3) (safety 0)))
+  (dotimes (i n t)
+    (if (= (the (unsigned-byte 16) (aref vector i)) #xd00)
+      (setf (aref vector i) #xa00))))
+
+(defun swapped-u16-translate-lf-to-cr (vector n)
+  (declare (type (simple-array (unsigned-byte 16) (*)) vector)
+           (type index n)
+           (optimize (speed 3) (safety 0)))
+  (dotimes (i n t)
+    (if (= (the (unsigned-byte 16) (aref vector i)) #xa00)
+      (setf (aref vector i) #xd00))))
+
+(defun swapped-u32-translate-cr-to-lf (vector n)
+  (declare (type (simple-array (unsigned-byte 32) (*)) vector)
+           (type index n)
+           (optimize (speed 3) (safety 0)))
+  (dotimes (i n t)
+    (if (= (the (unsigned-byte 32) (aref vector i)) #xd000000)
+      (setf (aref vector i) #xa000000))))
+
+(defun swapped-32-translate-lf-to-cr (vector n)
+  (declare (type (simple-array (unsigned-byte 32) (*)) vector)
+           (type index n)
+           (optimize (speed 3) (safety 0)))
+  (dotimes (i n t)
+    (if (= (the (unsigned-byte 32) (aref vector i)) #xa000000)
+      (setf (aref vector i) #xd0000000))))
 
 (declaim (inline %ioblock-force-output))
@@ -1554,4 +1647,17 @@
                buf idx string len more)
               (incf len more))))))))
+
+;;; There are lots of ways of doing better here, but in the most general
+;;; case we can't tell (a) what a newline looks like in the buffer or (b)
+;;; whether there's a 1:1 mapping between code units and characters.
+(defun %ioblock-encoded-read-line (ioblock)
+  (let* ((str (make-array 20 :element-type 'base-char
+			  :adjustable t :fill-pointer 0))
+         (rcf (ioblock-read-char-when-locked-function ioblock))
+	 (eof nil))
+    (do* ((ch (funcall rcf ioblock) (funcall rcf ioblock)))
+	 ((or (eq ch #\newline) (setq eof (eq ch :eof)))
+	  (values (ensure-simple-string str) eof))
+      (vector-push-extend ch str))))
 	 
 (defun %ioblock-unencoded-character-read-vector (ioblock vector start end)
@@ -1579,4 +1685,16 @@
 	  (incf i avail)
 	  (decf need avail))))))
+
+(defun %ioblock-encoded-character-read-vector (ioblock vector start end)
+  (declare (fixnum start end))
+  (do* ((i start (1+ i))
+        (rcf (ioblock-read-char-when-locked-function ioblock)))
+       ((= i end) end)
+    (declare (fixnum i need))
+    (let* ((ch (funcall rcf ioblock)))
+      (if (eq ch :eof)
+	(return i))
+      (setf (schar vector i) ch))))
+
 
 (defun %ioblock-binary-read-vector (ioblock vector start end)
@@ -1721,4 +1839,9 @@
     (if encoding
       (let* ((unit-size (character-encoding-code-unit-size encoding)))
+        (setf (ioblock-peek-char-function ioblock) '%encoded-ioblock-peek-char)
+        (setf (ioblock-read-line-function ioblock)
+              '%ioblock-encoded-read-line)
+        (setf (ioblock-character-read-vector-function ioblock)
+              '%ioblock-encoded-character-read-vector)        
         (setf (ioblock-decode-input-function ioblock)
               (character-encoding-stream-decode-function encoding))
@@ -1733,4 +1856,5 @@
                    (t '%ioblock-read-u8-encoded-char))))))
       (progn
+        (setf (ioblock-peek-char-function ioblock) '%ioblock-peek-char)
         (setf (ioblock-read-char-function ioblock)
               (case sharing
@@ -1836,5 +1960,5 @@
                  (case sharing
                    (:private '%private-ioblock-write-u8-encoded-char)
-                   (:lock '%locked-ioblock-write-u8-encoded-charchar)
+                   (:lock '%locked-ioblock-write-u8-encoded-char)
                    (t '%ioblock-write-u8-encoded-char)))))
         (setf (ioblock-write-simple-string-function ioblock)
@@ -1957,4 +2081,5 @@
                             character-p
                             encoding
+                            line-termination
                             &allow-other-keys)
   (declare (ignorable element-shift))
@@ -1978,4 +2103,5 @@
       (setf (ioblock-owner ioblock) *current-process*))
     (setf (ioblock-encoding ioblock) encoding)
+    (setf (ioblock-line-termination ioblock) line-termination)
     (setf (ioblock-literal-char-code-limit ioblock)
           (if encoding
@@ -2089,5 +2215,6 @@
                                            (subtypep element-type 'character)))
                           (basic nil)
-                          encoding)
+                          encoding
+                          line-termination)
   (when basic
     (setq class (map-to-basic-stream-class-name class))
@@ -2115,5 +2242,6 @@
                          :sharing sharing
                          :character-p character-p
-                         :encoding encoding)))
+                         :encoding encoding
+                         :line-termination line-termination)))
   
 ;;;  Fundamental streams.
@@ -2248,31 +2376,4 @@
   (generic-stream-write-string stream string start end))
 
-(defmethod stream-write-list ((stream fundamental-character-output-stream)
-			      list count)
-  (declare (fixnum count))
-  (dotimes (i count)
-    (stream-write-char stream (pop list))))
-
-(defmethod stream-read-list ((stream fundamental-character-input-stream)
-			     list count)
-  (generic-character-read-list stream list count))
-
-(defmethod stream-write-list ((stream fundamental-binary-output-stream)
-			      list count)
-  (declare (fixnum count))
-  (dotimes (i count)
-    (stream-write-byte stream (pop list))))
-
-(defmethod stream-read-list ((stream fundamental-binary-input-stream)
-			     list count)
-  (declare (fixnum count))
-  (do* ((tail list (cdr tail))
-	(i 0 (1+ i)))
-       ((= i count) count)
-    (declare (fixnum i))
-    (let* ((b (stream-read-byte stream)))
-      (if (eq b :eof)
-	(return i)
-	(rplaca tail b)))))
 
 ;;; The read-/write-vector methods could be specialized for stream classes
@@ -2423,4 +2524,61 @@
   (declare (dynamic-extent args))
   (apply #'make-ioblock :stream stream args))
+
+
+(defmethod stream-write-list ((stream fundamental-character-output-stream)
+			      list count)
+  (declare (fixnum count))
+  (dotimes (i count)
+    (stream-write-char stream (pop list))))
+
+(defmethod stream-write-list ((stream basic-character-output-stream)
+			      list count)
+  (declare (fixnum count))
+  (dotimes (i count)
+    (stream-write-char stream (pop list))))
+
+(defmethod stream-read-list ((stream fundamental-character-input-stream)
+			     list count)
+  (generic-character-read-list stream list count))
+
+(defmethod stream-read-list ((stream basic-character-input-stream)
+			     list count)
+  (generic-character-read-list stream list count))
+
+(defmethod stream-write-list ((stream fundamental-binary-output-stream)
+			      list count)
+  (declare (fixnum count))
+  (dotimes (i count)
+    (stream-write-byte stream (pop list))))
+
+(defmethod stream-write-list ((stream basic-binary-output-stream)
+			      list count)
+  (declare (fixnum count))
+  (dotimes (i count)
+    (write-byte (pop list) stream)))
+
+(defmethod stream-read-list ((stream fundamental-binary-input-stream)
+			     list count)
+  (declare (fixnum count))
+  (do* ((tail list (cdr tail))
+	(i 0 (1+ i)))
+       ((= i count) count)
+    (declare (fixnum i))
+    (let* ((b (stream-read-byte stream)))
+      (if (eq b :eof)
+	(return i)
+	(rplaca tail b)))))
+
+(defmethod stream-read-list ((stream basic-binary-input-stream)
+			     list count)
+  (declare (fixnum count))
+  (do* ((tail list (cdr tail))
+	(i 0 (1+ i)))
+       ((= i count) count)
+    (declare (fixnum i))
+    (let* ((b (read-byte stream)))
+      (if (eq b :eof)
+	(return i)
+	(rplaca tail b)))))
 
 (defmethod stream-read-vector ((stream basic-character-input-stream)
@@ -3459,4 +3617,5 @@
     (%ioblock-binary-in-ivect ioblock iv start nb)))
 
+
 (defmethod stream-write-vector ((stream buffered-character-output-stream-mixin)
 				vector start end)
@@ -3467,13 +3626,18 @@
       (let* ((total (- end start)))
 	(declare (fixnum total))
-	(%ioblock-out-ivect ioblock vector start total)
-	(let* ((last-newline (position #\newline vector
-				       :start start
-				       :end end
-				       :from-end t)))
-	  (if last-newline
-	    (setf (ioblock-charpos ioblock)
-		  (- end last-newline 1))
-	    (incf (ioblock-charpos ioblock) total)))))))
+        (funcall (ioblock-write-simple-string-function ioblock)
+                 ioblock vector start total)))))
+
+(defmethod stream-write-vector ((stream basic-character-output-stream)
+				vector start end)
+  (declare (fixnum start end))
+  (if (not (typep vector 'simple-base-string))
+    (call-next-method)
+    (let* ((ioblock (basic-stream-ioblock stream))
+           (total (- end start)))
+      (declare (fixnum total))
+      (with-ioblock-output-locked (ioblock)
+                (funcall (ioblock-write-simple-string-function ioblock)
+                 ioblock vector start total)))))
 
 (defmethod stream-write-vector ((stream buffered-binary-output-stream-mixin)
@@ -4139,5 +4303,5 @@
     (stream-line-column stream)))        
 
-
+