diff options
Diffstat (limited to 'judge')
| -rw-r--r-- | judge/_tags | 2 | ||||
| -rw-r--r-- | judge/core.ml | 49 |
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 |