Permalink
Browse files

Sockets: only register an Activation after the socket operation regis…

…ters a blocking condition, and not before. This dramatically speeds up the server under load, since it otherwise spends all its time registering with the select handler.
  • Loading branch information...
avsm committed Mar 24, 2011
1 parent 06f3e44 commit 5cabf06ac837ab84138b04ce1096e3f9079a60d5
Showing with 11 additions and 10 deletions.
  1. +6 −5 lib/net/socket/datagram.ml
  2. +5 −5 lib/net/socket/flow.ml
View
@@ -36,7 +36,6 @@ module UDPv4 = struct
|None -> return (Manager.get_udpv4 mgr)
|Some src -> Manager.get_udpv4_listener mgr src
in
- Activations.write (R.fd_to_int fd) >>
let raw = OS.Istring.raw req in
let off = OS.Istring.off req in
let len = OS.Istring.length req in
@@ -47,14 +46,15 @@ module UDPv4 = struct
fail (Error "partial UDP send")
else
return ()
- |R.Retry -> send mgr (dstaddr, dstport) req
+ |R.Retry ->
+ Activations.write (R.fd_to_int fd) >>
+ send mgr (dstaddr, dstport) req
|R.Err err -> fail (Error err)
let recv mgr (addr,port) fn =
lwt lfd = Manager.get_udpv4_listener mgr (addr,port) in
+ let istr = OS.Istring.Raw.alloc () in
let rec listen () =
- lwt () = Activations.read (R.fd_to_int lfd) in
- let istr = OS.Istring.Raw.alloc () in
match R.udpv4_recvfrom lfd istr 0 4096 with
|R.OK (frm_addr, frm_port, len) ->
let frm_addr = ipv4_addr_of_uint32 frm_addr in
@@ -69,7 +69,8 @@ module UDPv4 = struct
return (Printf.printf "EXN: %s\n%!" (Printexc.to_string exn))
);
listen ()
- |R.Retry -> listen ()
+ |R.Retry ->
+ lwt () = Activations.read (R.fd_to_int lfd) in listen ()
|R.Err _ -> return ()
in
listen ()
View
@@ -72,7 +72,6 @@ let listen_tcpv4 addr port fn =
|R.OK () ->
let rec loop t =
with_value id (new_id ()) (fun () ->
- Activations.read (R.fd_to_int t.fd) >>
(match R.tcpv4_accept fd with
|R.OK (afd,caddr_i,cport) ->
let caddr = ipv4_addr_of_uint32 caddr_i in
@@ -88,7 +87,7 @@ let listen_tcpv4 addr port fn =
)
);
loop t
- |R.Retry -> loop t
+ |R.Retry -> Activations.read (R.fd_to_int t.fd) >> loop t
|R.Err err -> fail (Accept_error err)
)
) in
@@ -156,12 +155,13 @@ module TCPv4 = struct
(* Wait for the connect to complete *)
let t = t_of_fd fd in
let rec loop () =
- Activations.write (R.fd_to_int t.fd) >>
match R.connect_result t.fd with
|R.OK _ ->
close_on_exit t fn
- |R.Err s -> fail (Connect_error s)
- |R.Retry -> loop () in
+ |R.Retry ->
+ Activations.write (R.fd_to_int t.fd) >>
+ loop ()
+ |R.Err s -> fail (Connect_error s) in
let cancel_t = t.abort_t >> fail (Connect_error "cancelled") in
loop () <?> cancel_t
|R.Err s -> failwith s

0 comments on commit 5cabf06

Please sign in to comment.