[usocket-cvs] r382 - in usocket/branches/new-wfi: . backend

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Thu Jul 24 17:18:46 2008
New Revision: 382

Modified:
   usocket/branches/new-wfi/backend/allegro.lisp
   usocket/branches/new-wfi/backend/armedbear.lisp
   usocket/branches/new-wfi/backend/clisp.lisp
   usocket/branches/new-wfi/backend/cmucl.lisp
   usocket/branches/new-wfi/backend/lispworks.lisp
   usocket/branches/new-wfi/backend/openmcl.lisp
   usocket/branches/new-wfi/backend/sbcl.lisp
   usocket/branches/new-wfi/backend/scl.lisp
   usocket/branches/new-wfi/usocket.lisp
Log:
Make sockets clean up their associated wait-list, if closed correctly.

Modified: usocket/branches/new-wfi/backend/allegro.lisp
==============================================================================
--- usocket/branches/new-wfi/backend/allegro.lisp	(original)
+++ usocket/branches/new-wfi/backend/allegro.lisp	Thu Jul 24 17:18:46 2008
@@ -63,6 +63,8 @@
 ;; because socket-streams are also sockets.
 (defmethod socket-close ((usocket usocket))
   "Close socket."
+  (when (wait-list usocket)
+     (remove-waiter (wait-list usocket) usocket))
   (with-mapped-conditions (usocket)
     (close (socket usocket))))
 

Modified: usocket/branches/new-wfi/backend/armedbear.lisp
==============================================================================
--- usocket/branches/new-wfi/backend/armedbear.lisp	(original)
+++ usocket/branches/new-wfi/backend/armedbear.lisp	Thu Jul 24 17:18:46 2008
@@ -245,6 +245,8 @@
 ;;    (print (jcall (jmethod "java.net.BindException" "getMessage") native-exception))))
 
 (defmethod socket-close ((usocket usocket))
+  (when (wait-list usocket)
+     (remove-waiter (wait-list usocket) usocket))
   (with-mapped-conditions (usocket)
     (jdi:do-jmethod (socket usocket) "close")))
 
@@ -252,6 +254,8 @@
 ;; socket streams. Closing the stream flushes
 ;; its buffers *and* closes the socket.
 (defmethod socket-close ((usocket stream-usocket))
+  (when (wait-list usocket)
+     (remove-waiter (wait-list usocket) usocket))
   (with-mapped-conditions (usocket)
     (close (socket-stream usocket))))
 

Modified: usocket/branches/new-wfi/backend/clisp.lisp
==============================================================================
--- usocket/branches/new-wfi/backend/clisp.lisp	(original)
+++ usocket/branches/new-wfi/backend/clisp.lisp	Thu Jul 24 17:18:46 2008
@@ -96,10 +96,14 @@
 ;; are the same object
 (defmethod socket-close ((usocket usocket))
   "Close socket."
+  (when (wait-list usocket)
+     (remove-waiter (wait-list usocket) usocket))
   (with-mapped-conditions (usocket)
     (close (socket usocket))))
 
 (defmethod socket-close ((usocket stream-server-usocket))
+  (when (wait-list usocket)
+     (remove-waiter (wait-list usocket) usocket))
   (socket:socket-server-close (socket usocket)))
 
 (defmethod get-local-name ((usocket usocket))
@@ -227,6 +231,8 @@
       rv))
 
   (defmethod socket-close ((usocket datagram-usocket))
+    (when (wait-list usocket)
+       (remove-waiter (wait-list usocket) usocket))
     (rawsock:sock-close (socket usocket)))
 
   )

Modified: usocket/branches/new-wfi/backend/cmucl.lisp
==============================================================================
--- usocket/branches/new-wfi/backend/cmucl.lisp	(original)
+++ usocket/branches/new-wfi/backend/cmucl.lisp	Thu Jul 24 17:18:46 2008
@@ -97,11 +97,15 @@
 ;; socket stream when closing a stream socket.
 (defmethod socket-close ((usocket stream-usocket))
   "Close socket."
+  (when (wait-list usocket)
+     (remove-waiter (wait-list usocket) usocket))
   (with-mapped-conditions (usocket)
     (close (socket-stream usocket))))
 
 (defmethod socket-close ((usocket usocket))
   "Close socket."
+  (when (wait-list usocket)
+     (remove-waiter (wait-list usocket) usocket))
   (with-mapped-conditions (usocket)
     (ext:close-socket (socket usocket))))
 

Modified: usocket/branches/new-wfi/backend/lispworks.lisp
==============================================================================
--- usocket/branches/new-wfi/backend/lispworks.lisp	(original)
+++ usocket/branches/new-wfi/backend/lispworks.lisp	Thu Jul 24 17:18:46 2008
@@ -117,9 +117,13 @@
 ;; are correctly flushed and the socket closed.
 (defmethod socket-close ((usocket stream-usocket))
   "Close socket."
+  (when (wait-list usocket)
+     (remove-waiter (wait-list usocket) usocket))
   (close (socket-stream usocket)))
 
 (defmethod socket-close ((usocket usocket))
+  (when (wait-list usocket)
+     (remove-waiter (wait-list usocket) usocket))
   (with-mapped-conditions (usocket)
      (comm::close-socket (socket usocket))))
 

Modified: usocket/branches/new-wfi/backend/openmcl.lisp
==============================================================================
--- usocket/branches/new-wfi/backend/openmcl.lisp	(original)
+++ usocket/branches/new-wfi/backend/openmcl.lisp	Thu Jul 24 17:18:46 2008
@@ -106,6 +106,8 @@
 ;; and their associated objects are represented
 ;; by the same object.
 (defmethod socket-close ((usocket usocket))
+  (when (wait-list usocket)
+     (remove-waiter (wait-list usocket) usocket))
   (with-mapped-conditions (usocket)
     (close (socket usocket))))
 

Modified: usocket/branches/new-wfi/backend/sbcl.lisp
==============================================================================
--- usocket/branches/new-wfi/backend/sbcl.lisp	(original)
+++ usocket/branches/new-wfi/backend/sbcl.lisp	Thu Jul 24 17:18:46 2008
@@ -244,10 +244,14 @@
 ;; different objects. Be sure to close the stream (which
 ;; closes the socket too) when closing a stream-socket.
 (defmethod socket-close ((usocket usocket))
+  (when (wait-list usocket)
+     (remove-waiter (wait-list usocket) usocket))
   (with-mapped-conditions (usocket)
     (sb-bsd-sockets:socket-close (socket usocket))))
 
 (defmethod socket-close ((usocket stream-usocket))
+  (when (wait-list usocket)
+     (remove-waiter (wait-list usocket) usocket))
   (with-mapped-conditions (usocket)
     (close (socket-stream usocket))))
 

Modified: usocket/branches/new-wfi/backend/scl.lisp
==============================================================================
--- usocket/branches/new-wfi/backend/scl.lisp	(original)
+++ usocket/branches/new-wfi/backend/scl.lisp	Thu Jul 24 17:18:46 2008
@@ -69,11 +69,15 @@
 ;; are flushed and the socket is closed correctly afterwards.
 (defmethod socket-close ((usocket usocket))
   "Close socket."
+  (when (wait-list usocket)
+     (remove-waiter (wait-list usocket) usocket))
   (with-mapped-conditions (usocket)
     (ext:close-socket (socket usocket))))
 
 (defmethod socket-close ((usocket stream-usocket))
   "Close socket."
+  (when (wait-list usocket)
+     (remove-waiter (wait-list usocket) usocket))
   (with-mapped-conditions (usocket)
     (close (socket-stream usocket))))
 

Modified: usocket/branches/new-wfi/usocket.lisp
==============================================================================
--- usocket/branches/new-wfi/usocket.lisp	(original)
+++ usocket/branches/new-wfi/usocket.lisp	Thu Jul 24 17:18:46 2008
@@ -16,6 +16,10 @@
     :initarg :socket
     :accessor socket
     :documentation "Implementation specific socket object instance.'")
+   (wait-list
+    :initform nil
+    :accessor wait-list
+    :documentation "WAIT-LIST the object is associated with.")
    (state
     :initform nil
     :accessor state
@@ -225,8 +229,8 @@
 ;; Implementation specific:
 ;;
 ;;  %setup-wait-list
-;;  add-waiter
-;;  remove-waiter
+;;  %add-waiter
+;;  %remove-waiter
 
 (declaim (inline %setup-wait-list
                  %add-waiter
@@ -241,17 +245,23 @@
     wl))
 
 (defun add-waiter (wait-list input)
-  (setf (gethash (socket input) (wait-list-map wait-list)) input)
+  (setf (gethash (socket input) (wait-list-map wait-list)) input
+        (wait-list input) wait-list)
   (pushnew input (wait-list-waiters wait-list))
   (%add-waiter wait-list input))
 
 (defun remove-waiter (wait-list input)
   (%remove-waiter wait-list input)
   (setf (wait-list-waiters wait-list)
-        (remove input (wait-list-waiters wait-list)))
+        (remove input (wait-list-waiters wait-list))
+        (wait-list input) nil)
   (remhash (socket input) (wait-list-map wait-list)))
 
-
+(defun remove-all-waiters (wait-list)
+  (dolist (waiter (wait-list-waiters wait-list))
+    (%remove-waiter waiter))
+  (setf (wait-list-waiters wait-list) nil)
+  (clrhash (wait-list-map wait-list)))
 
 
 (defun wait-for-input (socket-or-sockets &key timeout ready-only)