Yield the CPU every 1000 transmissions to a given node, and synchronously deliver.

This commit is contained in:
Tony Garnock-Jones 2012-05-05 23:06:53 -04:00
parent 03a165eae7
commit 536f1a03d2
1 changed files with 15 additions and 6 deletions

21
node.ml
View File

@ -22,10 +22,11 @@ open Status
type handle_message_t = t -> Sexp.t -> unit Lwt.t
and t = {
mutable names: StringSet.t;
class_name: string;
handle_message: handle_message_t
}
mutable names: StringSet.t;
mutable send_counter: int;
class_name: string;
handle_message: handle_message_t
}
and name = {
label: string;
mutable binding: t option
@ -52,6 +53,7 @@ let local_container_name () = "server"
let make class_name handler = {
names = StringSet.empty;
send_counter = 0;
class_name = class_name;
handle_message = handler
}
@ -120,12 +122,19 @@ let unbind_all n =
let send name body =
match lookup name with
| Some n ->
ignore
lwt () =
(try_lwt n.handle_message n body
with e ->
Log.warn "Node message handler raised exception"
[Sexp.Str name.label;
Sexp.Str (Printexc.to_string e)]);
Sexp.Str (Printexc.to_string e)])
in
n.send_counter <- n.send_counter + 1;
lwt () =
if n.send_counter >= 1000
then (n.send_counter <- 0; Lwt_unix.yield ())
else return ()
in
return true
| None ->
return false