(* $Id: netsys_pollset_generic.ml 1696 2012-02-08 19:27:53Z gerd $ *)

open Netsys_pollset

let standard_pollset() =
  match Sys.os_type with
    | "Win32" ->
	if ( !Netsys_oothr.provider ) # single_threaded then
	  Netsys_pollset_win32.pollset()
	else
	  Netsys_pollset_win32.threaded_pollset()
    | _ ->
	Netsys_pollset_posix.poll_based_pollset()


let performance_pollset() =
  match Sys.os_type with
    | "Win32" ->
	standard_pollset()
    | _ ->
	Netsys_pollset_posix.accelerated_pollset()


let select_emulation (pset : Netsys_pollset.pollset) =
  let tab = Hashtbl.create 20 in

  let enter fd new_req1 =
    let old_req, new_req2 =
      try Hashtbl.find tab fd
      with Not_found -> (0,0) in
    Hashtbl.replace tab fd (old_req, new_req1 lor new_req2) in

  let shift() =
    let l = ref [] in
    Hashtbl.iter
      (fun fd pair -> l := (fd, pair) :: !l)
      tab;
    List.iter
      (fun (fd, (old_req, new_req)) ->
	 Hashtbl.replace tab fd (new_req, 0)
      )
      !l in

  fun rdlist wrlist prilist tmo ->
    shift();
    List.iter (fun fd -> enter fd Netsys_posix.const_rd_event) rdlist;
    List.iter (fun fd -> enter fd Netsys_posix.const_wr_event) wrlist;
    List.iter (fun fd -> enter fd Netsys_posix.const_pri_event) prilist;

    let to_del = ref [] in
    Hashtbl.iter
      (fun fd (old_req, new_req) ->
	 if new_req = 0 then (
	   pset # remove fd;
	   to_del := fd :: !to_del
	 )
	 else
	   pset # add fd (Netsys_posix.req_events_of_int new_req)
      )
      tab;
    List.iter (fun fd -> Hashtbl.remove tab fd) !to_del;

    let l = pset # wait tmo in
    
    let rdout = ref [] in
    let wrout = ref [] in
    let priout = ref [] in
    List.iter
      (fun (fd, req, ev) ->
	 let req = Netsys_posix.int_of_req_events req in
	 let p_rd = (req land Netsys_posix.const_rd_event) <> 0 in
	 let p_wr = (req land Netsys_posix.const_wr_event) <> 0 in
	 let p_pri = (req land Netsys_posix.const_pri_event) <> 0 in
	 let err = Netsys_posix.poll_err_result ev in
	 let hup = Netsys_posix.poll_hup_result ev in
	 let nval = Netsys_posix.poll_nval_result ev in
	 if nval then
	   raise(Unix.Unix_error(Unix.EBADF, "select_emulation", ""));
	 if p_rd && (err || hup || Netsys_posix.poll_rd_result ev) then
	   rdout := fd :: !rdout;
	 if p_wr && (err || Netsys_posix.poll_wr_result ev) then
	   wrout := fd :: !wrout;
	 if p_pri && (err || Netsys_posix.poll_pri_result ev) then
	   priout := fd :: !priout;
      )
      l;

    (!rdout, !wrout, !priout)