From cc11434965110da8588ca28e1b515fb8d63e796c Mon Sep 17 00:00:00 2001
From: Stelian Ionescu <sionescu@common-lisp.net>
Date: Fri, 19 Jan 2007 02:11:25 +0100
Subject: [PATCH] Renamed socket-non-blocking-mode to socket-non-blocking and
 fixed it.

---
 sockets/base-sockets.lisp   |  4 ++--
 sockets/defpackage.lisp     |  2 +-
 sockets/socket-methods.lisp | 29 +++++++++++++++--------------
 3 files changed, 18 insertions(+), 17 deletions(-)

diff --git a/sockets/base-sockets.lisp b/sockets/base-sockets.lisp
index e6e431c..20c3079 100644
--- a/sockets/base-sockets.lisp
+++ b/sockets/base-sockets.lisp
@@ -37,8 +37,8 @@
 
 (defgeneric socket-type (socket))
 
-(defgeneric socket-non-blocking-mode (socket))
-(defgeneric (setf socket-non-blocking-mode) (value socket))
+(defgeneric socket-non-blocking (socket))
+(defgeneric (setf socket-non-blocking) (value socket))
 
 (defgeneric socket-close (socket)
   (:method-combination progn :most-specific-last))
diff --git a/sockets/defpackage.lisp b/sockets/defpackage.lisp
index 4ba1a42..563393c 100644
--- a/sockets/defpackage.lisp
+++ b/sockets/defpackage.lisp
@@ -98,7 +98,7 @@
    #:socket-fd #:socket-address #:socket-family #:socket-protocol
    #:socket-lisp-stream #:get-socket-option #:set-socket-option
    #:socket-type #:make-socket #:socket-close #:socket-open-p
-   #:socket-non-blocking-mode #:local-name #:remote-name
+   #:socket-non-blocking #:local-name #:remote-name
    #:bind-address #:socket-listen #:accept-connection
    #:connect  #:unconnect #:socket-connected-p
    #:shutdown #:socket-send  #:socket-receive
diff --git a/sockets/socket-methods.lisp b/sockets/socket-methods.lisp
index 30358bb..14be9f9 100644
--- a/sockets/socket-methods.lisp
+++ b/sockets/socket-methods.lisp
@@ -221,21 +221,22 @@
 ;;  get and set O_NONBLOCK  ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defmethod socket-non-blocking-mode ((socket socket))
+(defmethod socket-non-blocking ((socket socket))
   (with-slots (fd) socket
-    (let ((file-flags (with-socket-error-filter
-                        (et:fcntl fd et:f-getfl))))
-      (not (zerop (logand file-flags et:o-nonblock)))))
-  (values socket))
+    (let ((current-flags (with-socket-error-filter
+                           (et:fcntl fd et:f-getfl))))
+      (logtest et:o-nonblock current-flags))))
 
-(defmethod (setf socket-non-blocking-mode) (value (socket socket))
+(defmethod (setf socket-non-blocking) (value (socket socket))
   (check-type value boolean "a boolean value")
   (with-slots (fd) socket
-    (let ((file-flags (et:fcntl fd et:f-getfl)))
-      (with-socket-error-filter
-        (et:fcntl fd et:f-setfl
-                  (logior file-flags
-                          (if value et:o-nonblock 0))))))
+    (with-socket-error-filter
+      (let* ((current-flags (et:fcntl fd et:f-getfl))
+             (new-flags (if value
+                            (logior current-flags et:o-nonblock)
+                            (logandc2 current-flags et:o-nonblock))))
+        (when (/= new-flags current-flags)
+          (et:fcntl fd et:f-setfl new-flags)))))
   (values value))
 
 
@@ -411,13 +412,13 @@
                   (unwind-protect
                        (progn
                          ;; saving the current non-blocking state
-                         (setf non-blocking-state (socket-non-blocking-mode socket))
+                         (setf non-blocking-state (socket-non-blocking socket))
                          ;; switch the socket to non-blocking mode
-                         (setf (socket-non-blocking-mode socket) t)
+                         (setf (socket-non-blocking socket) t)
                          (setf client-fd (et:accept (socket-fd socket)
                                                     ss size)))
                     ;; restoring the socket's non-blocking state
-                    (setf (socket-non-blocking-mode socket) non-blocking-state)))
+                    (setf (socket-non-blocking socket) non-blocking-state)))
             ;; the socket is marked non-blocking and there's no new connection
             (et:unix-error-wouldblock (err)
               (declare (ignore err))
-- 
2.11.4.GIT