Changeset 424

Timestamp:

Jan 30, 2004, 11:43:21 AM (21 years ago)

Author:

Gary Byers

Message:

CLOSE: set the closed slot to ... something non-NULL.
STREAM-IO-ERROR: so things like sockets can specialize it.
Need to test ELEMENT-SHIFT stuff; not sure if I merged Bryan's patch correctly.

File:

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

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

@@ -203 +203 @@
   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 +249 @@
   (declare (ignore abort))
   (with-slots ((closed closed)) stream
-      (unless closed
-        (setf closed nil))))
+    (unless closed
+      (setf closed t))))
 
 
@@ -822 +826 @@
 
 (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 +857 @@
                                 :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 +874 @@
               (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 +2166 @@
           (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 +2211 @@
           (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)