open Sys;; open Unix;; open Inet;; let try_finalize f x finally y = let res = try f x with exn -> finally y; raise exn in finally y; res;; let establish_fixed_thread_number_server n f port = let socket_server = open_server port in let mutex = Mutex.create() in ignore (signal sigpipe Signal_ignore); let rec exclusive_accept () = begin try Mutex.lock mutex; let socket_connection, client_addr = try_finalize accept socket_server Mutex.unlock mutex in Printf.eprintf "Connection from %s.\n" (string_of_sockaddr client_addr); Pervasives.flush Pervasives.stderr; f socket_connection with Unix_error(EINTR,_,_) -> () | _ -> prerr_endline "Unrecoverable error"; exit(1) end; exclusive_accept () in for i = 1 to n-1 do ignore (Thread.create exclusive_accept ()) done; exclusive_accept ();; |
type control = { mutex : Mutex.t; write_enable : Condition.t ; mutable readers : int };; let create () = { mutex = Mutex.create (); write_enable = Condition.create(); readers = 0; };; |
let write_protect ctl f x = Mutex.lock ctl.mutex; while ctl.readers > 0 do Condition.wait ctl.write_enable ctl.mutex done; try_finalize f x Mutex.unlock ctl.mutex;; let read_protect ctl f x = Mutex.lock ctl.mutex; ctl.readers <- ctl.readers + 1; Mutex.unlock ctl.mutex; let release() = Mutex.lock ctl.mutex; ctl.readers <- ctl.readers - 1; if ctl.readers = 0 then Condition.broadcast ctl.write_enable; Mutex.unlock ctl.mutex in try_finalize f x release ();; |