diff --git a/backend/lispworks.lisp b/backend/lispworks.lisp index 43368a7..acfe421 100644 --- a/backend/lispworks.lisp +++ b/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) diff --git a/option.lisp b/option.lisp index 011fc92..28ad1d0 100644 --- a/option.lisp +++ b/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