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)