Index: /trunk/ccl/level-1/l1-sockets.lisp
===================================================================
--- /trunk/ccl/level-1/l1-sockets.lisp	(revision 422)
+++ /trunk/ccl/level-1/l1-sockets.lisp	(revision 423)
@@ -114,5 +114,5 @@
   (require "DARWIN-SYSCALLS"))
 
-(define-condition socket-error (simple-error)
+(define-condition socket-error (simple-stream-error)
   ((code :initarg :code :reader socket-error-code)
    (identifier :initform :unknown :initarg :identifier :reader socket-error-identifier)
@@ -131,8 +131,8 @@
 	#$EHOSTDOWN :host-down
 	#$ENETDOWN :network-down
-	;; ?? :address-not-available
-	;; ?? :network-reset
-	;; ?? :connection-reset
-	;; ?? :shutdown
+	#$EADDRNOTAVAIL :address-not-available
+	#$ENETRESET :network-reset
+	#$ECONNRESET :connection-reset
+	#$ESHUTDOWN :shutdown
 	#$EACCES :access-denied
 	#$EPERM :access-denied))
@@ -140,7 +140,7 @@
 
 (declaim (inline socket-call))
-(defun socket-call (where res)
+(defun socket-call (stream where res)
   (if (< res 0)
-    (socket-error where res)
+    (socket-error stream where res)
     res))
 
@@ -151,20 +151,31 @@
       (format nil "Nameserver error ~d" (abs h_errno)))))
     
-  
-(defun socket-error (where errno &optional nameserver-p)
+
+
+
+(defun socket-error (stream where errno &optional nameserver-p)
   (when (< errno 0)
     (setq errno (- errno)))
-  (error (make-condition 'socket-error
-			 :code errno
-			 :identifier (getf *socket-error-identifiers* errno :unknown)
-			 :situation where
-			 ;; TODO: this is a constant arg, there is a way to put this
-			 ;; in the class definition, just need to remember how...
-			 :format-control "~a (error #~d) in ~a"
-			 :format-arguments (list
-                                            (if nameserver-p
-                                              (%hstrerror errno)
-                                              (%strerror errno))
-                                            errno where))))
+  (if stream
+    (error (make-condition 'socket-error
+			   :stream stream
+			   :code errno
+			   :identifier (getf *socket-error-identifiers* errno :unknown)
+			   :situation where
+			   ;; TODO: this is a constant arg, there is a way to put this
+			   ;; in the class definition, just need to remember how...
+			   :format-control "~a (error #~d) on ~s in ~a"
+			   :format-arguments (list
+					      (if nameserver-p
+						(%hstrerror errno)
+						(%strerror errno))
+					      errno stream where)))
+    (error "~a (error #~d) in ~a"
+	   (if nameserver-p
+	     (%hstrerror errno)
+	     (%strerror errno))
+	   errno where)))
+    
+
 
 ;; If true, this will try to allow other processes to run while
@@ -286,10 +297,10 @@
 
 ;; Returns nil for closed stream
-(defun local-socket-info (fd type)
+(defun local-socket-info (fd type socket)
   (and fd
        (rlet ((sockaddr :sockaddr_in)
 	      (namelen :signed))
 	     (setf (pref namelen :signed) (record-length :sockaddr_in))
-	     (socket-call "getsockname" (c_getsockname fd sockaddr namelen))
+	     (socket-call socket "getsockname" (c_getsockname fd sockaddr namelen))
 	     (when (= #$AF_INET (pref sockaddr :sockaddr_in.sin_family))
 	       (ecase type
@@ -305,10 +316,10 @@
     (%get-cstring (pref addr :sockaddr_un.sun_path))))
 
-(defun local-socket-filename (fd)
+(defun local-socket-filename (fd socket)
   (and fd
        (rlet ((addr :sockaddr_un)
               (namelen :signed))
          (setf (pref namelen :signed) (record-length :sockaddr_un))
-         (socket-call "getsockname" (c_getsockname fd addr namelen))
+         (socket-call socket "getsockname" (c_getsockname fd addr namelen))
 	 (path-from-unix-address addr))))
 
@@ -340,11 +351,11 @@
 
 (defmethod LOCAL-PORT ((socket socket))
-  (local-socket-info (socket-device socket) :port))
+  (local-socket-info (socket-device socket) :port socket))
 
 (defmethod LOCAL-HOST ((socket socket))
-  (local-socket-info (socket-device socket) :host))
+  (local-socket-info (socket-device socket) :host socket))
 
 (defmethod LOCAL-FILENAME ((socket socket))
-  (local-socket-filename (socket-device socket)))
+  (local-socket-filename (socket-device socket) socket))
 
 ;; Returns NIL if socket is not connected
@@ -385,5 +396,5 @@
     (setf (pref plinger :linger.l_onoff) (if linger 1 0)
 	  (pref plinger :linger.l_linger) (or linger 0))
-    (socket-call "setsockopt"
+    (socket-call nil "setsockopt"
 		 (c_setsockopt fd #$SOL_SOCKET #$SO_LINGER plinger 8)))
   (when (eq address-family :internet)
@@ -406,5 +417,5 @@
 		     (pref sockaddr :sockaddr_in.sin_port) port-n
 		     (pref sockaddr :sockaddr_in.sin_addr.s_addr) host-n)
-	       (socket-call "bind" (c_bind fd sockaddr (record-length :sockaddr_in)))))))
+	       (socket-call nil "bind" (c_bind fd sockaddr (record-length :sockaddr_in)))))))
   (when (and (eq address-family :file)
 	     (eq connect :passive)
@@ -412,5 +423,5 @@
     (bind-unix-socket fd local-filename))    
   (when *multiprocessing-socket-io*
-    (socket-call "fcntl" (fd-set-flag fd #$O_NONBLOCK))))
+    (socket-call nil "fcntl" (fd-set-flag fd #$O_NONBLOCK))))
 
 ;; I hope the inline declaration makes the &rest/apply's go away...
@@ -451,5 +462,5 @@
   (unwind-protect
     (let (socket)
-      (setq fd (socket-call "socket"
+      (setq fd (socket-call nil "socket"
 			    (c_socket #$AF_INET #$SOCK_DGRAM #$IPPROTO_UDP)))
       (apply #'set-socket-options fd keys)
@@ -465,5 +476,5 @@
   (unwind-protect
     (let (socket)
-      (setq fd (socket-call "socket"
+      (setq fd (socket-call nil "socket"
 			    (c_socket #$AF_INET #$SOCK_STREAM #$IPPROTO_TCP)))
       (apply #'set-socket-options fd keys)
@@ -480,5 +491,5 @@
   (unwind-protect
     (let (socket)
-      (setq fd (socket-call "socket" (c_socket #$PF_LOCAL #$SOCK_STREAM 0)))
+      (setq fd (socket-call nil "socket" (c_socket #$PF_LOCAL #$SOCK_STREAM 0)))
       (apply #'set-socket-options fd keys)
       (setq socket
@@ -557,5 +568,5 @@
 
 (defun make-tcp-listener-socket (fd &rest keys &key backlog &allow-other-keys)
-  (socket-call "listen" (c_listen fd (or backlog 5)))
+  (socket-call nil "listen" (c_listen fd (or backlog 5)))
   (make-instance 'listener-socket
 		 :device fd
@@ -563,10 +574,10 @@
 
 (defun make-file-listener-socket (fd &rest keys &key backlog &allow-other-keys)
-  (socket-call "listen" (c_listen fd (or backlog 5)))
+  (socket-call nil "listen" (c_listen fd (or backlog 5)))
   (make-instance 'file-listener-socket
 		 :device fd
 		 :keys keys))
 
-(defun socket-accept (fd wait)
+(defun socket-accept (fd wait socket)
   (flet ((_accept (fd async)
 	   (let ((res (c_accept fd (%null-ptr) (%null-ptr))))
@@ -593,10 +604,10 @@
 	    (_accept fd t))
 	  (t
-	    (let ((old (socket-call "fcntl" (fd-get-flags fd))))
+	    (let ((old (socket-call socket "fcntl" (fd-get-flags fd))))
 	      (unwind-protect
 		  (progn
-		    (socket-call "fcntl" (fd-set-flags fd (logior old #$O_NONBLOCK)))
+		    (socket-call socket "fcntl" (fd-set-flags fd (logior old #$O_NONBLOCK)))
 		    (_accept fd t))
-		(socket-call "fcntl" (fd-set-flags fd old))))))))
+		(socket-call socket "fcntl" (fd-set-flags fd old))))))))
 
 (defun accept-socket-connection (socket wait stream-create-function)
@@ -605,5 +616,5 @@
     (unwind-protect
       (progn
-	(setq fd (socket-accept listen-fd wait))
+	(setq fd (socket-accept listen-fd wait socket))
 	(cond ((>= fd 0)
 	       (prog1 (apply stream-create-function fd (socket-keys socket))
@@ -653,5 +664,5 @@
       (%stack-block ((bufptr size))
         (%copy-ivector-to-ptr msg offset bufptr 0 size)
-	(socket-call "sendto"
+	(socket-call socket "sendto"
 	  (with-eagain fd :output
 	    (c_sendto fd bufptr size 0 sockaddr (record-length :sockaddr_in))))))))
@@ -672,5 +683,5 @@
       (setf (pref namelen :signed) (record-length :sockaddr_in))
       (%stack-block ((bufptr size))
-	(setq ret-size (socket-call "recvfrom"
+	(setq ret-size (socket-call socket "recvfrom"
 			 (with-eagain fd :input
 			   (c_recvfrom fd bufptr size 0 sockaddr namelen))))
@@ -699,5 +710,5 @@
   ;; is a distinct, catchable error type).
   (let ((fd (socket-device socket)))
-    (socket-call "shutdown"
+    (socket-call socket "shutdown"
       (c_shutdown fd (ecase direction
 		       (:input 0)
@@ -768,5 +779,5 @@
   (rlet ((valptr :signed))
     (setf (pref valptr :signed) optval)
-    (socket-call "setsockopt"
+    (socket-call socket "setsockopt"
       (c_setsockopt socket level optname valptr (record-length :signed)))))
 
@@ -895,4 +906,5 @@
     (init-unix-sockaddr addr path)
     (socket-call
+     nil
      "bind"
      (c_bind socketfd
@@ -1176,2 +1188,4 @@
 	  
 	  
+(defmethod stream-io-error ((stream socket) errno where)
+  (socket-error stream where errno))