aboutsummaryrefslogtreecommitdiff
path: root/judge
diff options
context:
space:
mode:
Diffstat (limited to 'judge')
-rw-r--r--judge/_tags2
-rw-r--r--judge/core.ml49
2 files changed, 24 insertions, 27 deletions
diff --git a/judge/_tags b/judge/_tags
index 6c0a352..2f85c83 100644
--- a/judge/_tags
+++ b/judge/_tags
@@ -1 +1 @@
-true: use_unix, use_graphics
+true: use_unix, use_graphics, debug
diff --git a/judge/core.ml b/judge/core.ml
index 2838732..ec73639 100644
--- a/judge/core.ml
+++ b/judge/core.ml
@@ -80,6 +80,7 @@ module Core (G: GAME) : CORE = struct
and player_proc = {
pid: int;
+ cfd: file_descr list;
p: player;
i: in_channel;
o: out_channel;
@@ -218,11 +219,13 @@ module Core (G: GAME) : CORE = struct
players)
players
- let send_m pp m =
- let m = encode m in
- if !log_games then Format.printf ">%s< %s@." pp.p.name m;
- output_string pp.o (m ^ "\n");
- flush pp.o
+ let send_m (pp : player_proc) m =
+ if pp.s <> Dead then begin
+ let m = encode m in
+ if !log_games then Format.printf ">%s< %s@." pp.p.name m;
+ output_string pp.o (m ^ "\n");
+ flush pp.o
+ end
let handle_events () =
(* 1. IF NOT ENOUGH MATCHES ARE RUNING, LAUNCH ONE *)
@@ -251,6 +254,7 @@ module Core (G: GAME) : CORE = struct
let pl = { pid; p;
i = in_channel_of_descr p2j_i;
o = out_channel_of_descr j2p_o;
+ cfd = [p2j_i; p2j_o; j2p_i; j2p_o];
s = Loading } in
p.running <- Some pl;
send_m pl (Hello G.id);
@@ -276,29 +280,21 @@ module Core (G: GAME) : CORE = struct
end;
(* 2. LOOK IF ANYBODY IS TELLING US SOMETHING - IF SO, REACT
(wait max. 0.01 sec) *)
- let in_fd = List.fold_left
+ let in_fd_x = List.fold_left
(fun l g ->
- let l = match g.p1.s with
- | Dead -> l
- | _ -> (Unix.descr_of_in_channel g.p1.i)::l
- in match g.p2.s with
- | Dead -> l
- | _ -> (Unix.descr_of_in_channel g.p2.i)::l)
+ let l = if g.p1.s = Dead then l
+ else (Unix.descr_of_in_channel g.p1.i, (g, g.p1))::l
+ in if g.p2.s = Dead then l
+ else (Unix.descr_of_in_channel g.p2.i, (g, g.p2))::l)
[] !r_games
in
let in_fd, _, _ =
- try select in_fd [] [] 0.01
- with
- Unix_error (EINTR, _, _) -> [], [], []
+ try select (List.map fst in_fd_x) [] [] 0.01
+ with Unix_error (EINTR, _, _) -> [], [], []
in
let do_fd fd =
- let g = List.find
- (fun g -> fd = Unix.descr_of_in_channel g.p1.i
- || fd = Unix.descr_of_in_channel g.p2.i)
- !r_games
- in
- let pi = if Unix.descr_of_in_channel g.p1.i = fd then P1 else P2 in
- let p = match pi with P1 -> g.p1 | P2 -> g.p2 in
+ let (g, p) = List.assoc fd in_fd_x in
+ let pi = if p == g.p1 then P1 else P2 in
let op = match pi with P1 -> g.p2 | P2 -> g.p1 in
begin try
let l = input_line p.i in
@@ -339,7 +335,7 @@ module Core (G: GAME) : CORE = struct
in
if finished then begin
p.s <- Saving;
- op.s <- Saving;
+ if op.s <> Dead then op.s <- Saving;
end
| FairEnough, Saving ->
kill p.pid Sys.sigterm;
@@ -357,7 +353,7 @@ module Core (G: GAME) : CORE = struct
kill p.pid Sys.sigterm;
Format.printf "%s vs. %s: %s eliminated (%s)!@." g.p1.p.name g.p2.p.name p.p.name r;
p.p.score <- p.p.score + !pt_elim;
- op.s <- Saving;
+ if op.s <> Dead then op.s <- Saving;
p.s <- Saving;
g.s <- Eliminated pi
end;
@@ -381,7 +377,7 @@ module Core (G: GAME) : CORE = struct
w.p.score <- w.p.score + !pt_win;
l.p.score <- l.p.score + !pt_lose;
w.s <- Saving;
- l.s <- Saving
+ if l.s <> Dead then l.s <- Saving
end
| _ -> ()
in List.iter check_timeout !r_games;
@@ -403,11 +399,12 @@ module Core (G: GAME) : CORE = struct
send_m op YouWin;
Format.printf "%s vs. %s: %s eliminated (died...)!@." g.p1.p.name g.p2.p.name p.p.name;
p.p.score <- p.p.score + !pt_elim;
- op.s <- Saving;
+ if op.s <> Dead then op.s <- Saving;
g.s <- Eliminated pi
end;
p.s <- Dead;
p.p.running <- None;
+ List.iter close p.cfd;
end
with _ -> () end