[LW] (SOCKET-OPTION :TCP-NODELAY) reader/writer implemented on LispWo…

…rks 4/5/6/7

backend/lispworks.lisp

@@ -251,6 +251,34 @@
                 len)
     (float (/ (fli:dereference timeout) 1000))))
 
+#+lispworks4
+(defun set-socket-tcp-nodelay (socket-fd new-value)
+  "Set socket option: TCP_NODELAY, argument is a fixnum (0 or 1)"
+  (declare (type integer socket-fd)
+           (type (integer 0 1) new-value))
+  (fli:with-dynamic-foreign-objects ((zero-or-one :int))
+    (setf (fli:dereference zero-or-one) new-value)
+    (when (zerop (comm::setsockopt socket-fd
+                                   comm::*sockopt_sol_socket*
+                                   comm::*sockopt_tcp_nodelay*
+                                   (fli:copy-pointer zero-or-one
+                                                     :type '(:pointer #+win32 :char #-win32 :void))
+                                   (fli:size-of :int)))
+        new-value)))
+
+(defun get-socket-tcp-nodelay (socket-fd)
+  "Get socket option: TCP_NODELAY, return value is a fixnum (0 or 1)"
+  (declare (type integer socket-fd))
+  (fli:with-dynamic-foreign-objects ((zero-or-one :int)
+                                     (len :int))
+    (if (zerop (comm::getsockopt socket-fd
+                                 comm::*sockopt_sol_socket*
+                                 comm::*sockopt_tcp_nodelay*
+                                 (fli:copy-pointer zero-or-one
+                                                   :type '(:pointer #+win32 :char #-win32 :void))
+                                 len))
+        zero-or-one 0))) ; on error, return 0
+
 (defun initialize-dynamic-sockaddr (hostname service protocol &aux (original-hostname hostname))
   (declare (ignorable original-hostname))
   #+(or lispworks4 lispworks5 lispworks6.0)

option.lisp

@@ -275,10 +275,15 @@
     () ; TODO
     new-value))
 
-;;; Socket option: TCP-NO-DELAY (TCP_NODELAY), for TCP client
+;;; Socket option: TCP-NODELAY (TCP_NODELAY), for TCP client
 
 (defmethod socket-option ((usocket stream-usocket)
                           (option (eql :tcp-no-delay)) &key)
+  (declare (ignore option))
+  (socket-option usocket :tcp-nodelay))
+
+(defmethod socket-option ((usocket stream-usocket)
+                          (option (eql :tcp-nodelay)) &key)
   (declare (ignorable option))
   (let ((socket (socket usocket)))
     (declare (ignorable socket))
@@ -295,7 +300,7 @@
     #+ecl
     (sb-bsd-sockets::sockopt-tcp-nodelay socket)
     #+lispworks
-    () ; TODO
+    (int->bool (get-socket-tcp-nodelay socket))
     #+mcl
     () ; TODO
     #+mocl
@@ -307,6 +312,11 @@
 
 (defmethod (setf socket-option) (new-value (usocket stream-usocket)
                                            (option (eql :tcp-no-delay)) &key)
+  (declare (ignore option))
+  (setf (socket-option usocket :tcp-nodelay) new-value))
+
+(defmethod (setf socket-option) (new-value (usocket stream-usocket)
+                                           (option (eql :tcp-nodelay)) &key)
   (declare (type boolean new-value) (ignorable new-value option))
   (let ((socket (socket usocket)))
     (declare (ignorable socket))
@@ -323,7 +333,11 @@
     #+ecl
     (setf (sb-bsd-sockets::sockopt-tcp-nodelay socket) new-value)
     #+lispworks
-    (comm::set-socket-tcp-nodelay socket new-value)
+    (progn
+      #-lispworks4
+      (comm::set-socket-tcp-nodelay socket new-value)
+      #+lispworks4
+      (set-socket-tcp-nodelay socket (bool->int new-value)))
     #+mcl
     () ; TODO
     #+mocl