Index: /trunk/ccl/level-1/l1-streams.lisp
===================================================================
--- /trunk/ccl/level-1/l1-streams.lisp	(revision 423)
+++ /trunk/ccl/level-1/l1-streams.lisp	(revision 424)
@@ -203,4 +203,8 @@
   t)
 
+(defmethod stream-io-error ((stream stream) error-number context)
+  (error 'simple-stream-error :stream stream
+	 :format-control (format nil "~a during ~a"
+				 (%strerror error-number) context)))
 
 (defmethod instance-initialize :after ((stream input-stream) &key)
@@ -245,6 +249,6 @@
   (declare (ignore abort))
   (with-slots ((closed closed)) stream
-      (unless closed
-	(setf closed nil))))
+    (unless closed
+      (setf closed t))))
 
 
@@ -822,26 +826,27 @@
 
 (defun init-stream-ioblock (stream
-			    &key
-			    insize	; integer to allocate inbuf here, nil
+                            &key
+                            insize ; integer to allocate inbuf here, nil
                                         ; otherwise
-			    outsize	; integer to allocate outbuf here, nil
+                            outsize ; integer to allocate outbuf here, nil
                                         ; otherwise
-			    share-buffers-p ; true if input and output
+                            share-buffers-p ; true if input and output
                                         ; share a buffer
-			    (element-type 'character)
-			    device
-			    advance-function
-			    listen-function
-			    eofp-function
-			    force-output-function
-			    close-function
-			    element-shift
-			    interactive
-			    &allow-other-keys)
+                            element-type
+                            device
+                            advance-function
+                            listen-function
+                            eofp-function
+                            force-output-function
+                            close-function
+                            element-shift
+                            interactive
+                            &allow-other-keys)
+  (declare (ignorable element-shift))
   (let* ((ioblock (or (let* ((ioblock (stream-ioblock stream nil)))
-			(when ioblock
-			  (setf (ioblock-stream ioblock) stream)
-			  ioblock))
-		     (stream-create-ioblock stream))))
+                        (when ioblock
+                          (setf (ioblock-stream ioblock) stream)
+                          ioblock))
+                      (stream-create-ioblock stream))))
     (when insize
       (unless (ioblock-inbuf ioblock)
@@ -852,13 +857,15 @@
                                 :bufptr ptr
                                 :size in-size-in-octets
-				:limit insize))
-	  (setf (ioblock-inbuf-lock ioblock) (make-lock)))))
+                                :limit insize))
+          (setf (ioblock-inbuf-lock ioblock) (make-lock))
+          (setf (ioblock-element-shift ioblock) (1- (/ in-size-in-octets insize)))
+          )))
     (if share-buffers-p
-      (if insize
-        (progn (setf (ioblock-outbuf ioblock)
-		     (ioblock-inbuf ioblock))
-	       (setf (ioblock-outbuf-lock ioblock)
-		     (ioblock-inbuf-lock ioblock)))
-        (error "Can't share buffers unless insize is non-zero and non-null"))
+        (if insize
+            (progn (setf (ioblock-outbuf ioblock)
+                         (ioblock-inbuf ioblock))
+                   (setf (ioblock-outbuf-lock ioblock)
+                         (ioblock-inbuf-lock ioblock)))
+          (error "Can't share buffers unless insize is non-zero and non-null"))
       
       (when outsize
@@ -867,12 +874,16 @@
               (make-heap-buffer element-type outsize)
             (setf (ioblock-outbuf ioblock)
-		  (make-io-buffer :buffer buffer
-				  :bufptr ptr
-				  :count 0
-				  :limit outsize
-				  :size out-size-in-octets))
-	    (setf (ioblock-outbuf-lock ioblock) (make-lock))))))
-    (when element-shift
-      (setf (ioblock-element-shift ioblock) element-shift))
+                  (make-io-buffer :buffer buffer
+                                  :bufptr ptr
+                                  :count 0
+                                  :limit outsize
+                                  :size out-size-in-octets))
+            (setf (ioblock-outbuf-lock ioblock) (make-lock))
+            (setf (ioblock-element-shift ioblock) (1- (/ out-size-in-octets outsize)))
+            ))))
+    (when element-type
+      (setf (ioblock-element-type ioblock) element-type))
+;    (when element-shift
+;      (setf (ioblock-element-shift ioblock) element-shift))
     (when device
       (setf (ioblock-device ioblock) device))
@@ -2155,5 +2166,5 @@
           (declare (fixnum n))
           (if (< n 0)
-            (error 'simple-stream-error :stream s :format-control (%strerror n))
+            (stream-io-error s (- n) "read")
             (if (> n 0)
               (setf (io-buffer-count buf)
@@ -2200,7 +2211,5 @@
 	  (declare (fixnum written))
 	  (if (< written 0)
-            (error 'simple-stream-error
-                   :stream s
-                   :format-control (%strerror written)))
+	    (stream-io-error s (- written) "write"))
 	  (decf octets written)
 	  (unless (zerop octets)