(**************************************************************************)
(*                                                                        *)
(*  Ocamlviz --- real-time profiling tools for Objective Caml             *)
(*  Copyright (C) by INRIA - CNRS - Universite Paris Sud                  *)
(*  Authors: Julien Robert                                                *)
(*           Guillaume Von Tokarski                                       *)
(*           Sylvain Conchon                                              *)
(*           Jean-Christophe Filliatre                                    *)
(*           Fabrice Le Fessant                                           *)
(*  GNU Library General Public License version 2                          *)
(*  See file LICENSE for details                                          *)
(*                                                                        *)
(**************************************************************************)


module Point = struct

  type t = Monitor_impl.Point.t

  let create = 
    let p =  Monitor_impl.Point.create in
    Thread.yield (); p
      
  let kill t = Monitor_impl.Point.kill t; Thread.yield ()

  let observe p = Monitor_impl.Point.observe p; Thread.yield ()
    
  let observe_calls f = 
    let g = Monitor_impl.Point.observe_calls f in
    Thread.yield (); g
      
  let observe_calls2 f = 
    let g = Monitor_impl.Point.observe_calls2 f in
    Thread.yield (); g
      
  let observe_calls_rec f = 
    let g = Monitor_impl.Point.observe_calls_rec f in
    Thread.yield (); g
      
  let observe_calls_rec2 f = 
    let g = Monitor_impl.Point.observe_calls_rec2 f in
    Thread.yield (); g
      
end 

module Tag = struct

  type t = Monitor_impl.Tag.t

  module WeakHash = Monitor_impl.Tag.WeakHash
    
  let create = 
    let t = Monitor_impl.Tag.create in
    Thread.yield (); t

  let mark x y = 
    let value = Monitor_impl.Tag.mark x y in
    Thread.yield (); value

  let kill t = Monitor_impl.Tag.kill t; Thread.yield ()

  let set_period t p = Monitor_impl.Tag.set_period t p; Thread.yield ()

end 

module Time = struct 

  type t = Monitor_impl.Time.t

  let elapsed_time = 
    let e = Monitor_impl.Time.elapsed_time in
    Thread.yield (); e
      
  let create = 
    let t = Monitor_impl.Time.create in
    Thread.yield (); t
      
  let kill t = Monitor_impl.Time.kill t; Thread.yield ()
    
  let start t = Monitor_impl.Time.start t; Thread.yield ()
    
  let stop t = Monitor_impl.Time.stop t; Thread.yield ()
    
  let time f= 
    let g = Monitor_impl.Time.time f in
    Thread.yield (); g

end 


module Value = struct
  
  let observe_int_fct ?weak ?period s f = Monitor_impl.Value.observe_int_fct ?weak ?period s f; Thread.yield ()
    
  let observe_float_fct ?weak ?period s f = Monitor_impl.Value.observe_float_fct ?weak ?period s f; Thread.yield ()
    
  let observe_bool_fct ?weak ?period s f = Monitor_impl.Value.observe_bool_fct ?weak ?period s f; Thread.yield ()
    
  let observe_string_fct ?weak ?period s f = Monitor_impl.Value.observe_string_fct ?weak ?period s f; Thread.yield ()

  let observe_int ?weak ?period s i = Monitor_impl.Value.observe_int ?weak ?period s i; Thread.yield ()
    
  let observe_float ?weak ?period s f = Monitor_impl.Value.observe_float ?weak ?period s f; Thread.yield ()
    
  let observe_bool ?weak ?period s b = Monitor_impl.Value.observe_bool ?weak ?period s b; Thread.yield ()
    
  let observe_string ?weak ?period s s' = Monitor_impl.Value.observe_string ?weak ?period s s'; Thread.yield ()
    
  let observe_int_ref ?period s i = 
    let i' = Monitor_impl.Value.observe_int_ref ?period s i in
    Thread.yield (); i'
      
  let observe_float_ref ?period s f = 
    let f' = Monitor_impl.Value.observe_float_ref ?period s f in
    Thread.yield (); f' 
      
  let observe_bool_ref ?period s b = 
    let b' = Monitor_impl.Value.observe_bool_ref ?period s b in
    Thread.yield () ; b'
      
  let observe_string_ref ?period s str = 
    let str' = Monitor_impl.Value.observe_string_ref ?period s str in
    Thread.yield () ; str'
      
end


module Tree = struct

  type t = Monitor_impl.Tree.t

  let observe ?(period=100) name fct =
    Monitor_impl.Tree.observe ~period name fct;
    Thread.yield ()

end


module Hashtable = struct 
  
  type 'a t = 'a Monitor_impl.Hashtable.t
    
  let observe ?(period=100) name h =
    let h = Monitor_impl.Hashtable.observe ~period name h in
    Thread.yield ();
    h
    
end


let to_send = Monitor_impl.to_send
  
let declare_tags = Monitor_impl.declare_tags

let log f =
  Thread.yield ();
  Monitor_impl.log f

  
let wait_for_killed_clients () = Monitor_impl.wait_for_killed_clients (); Thread.yield ()
  
let wait_for_connected_clients i = Monitor_impl.wait_for_connected_clients i; Thread.yield ()
  
let set_nb_clients = Monitor_impl.set_nb_clients



open Printf
open Sys
open Unix

let debug = ref true

let sock = socket PF_INET SOCK_STREAM 0

let clients = ref ([] : out_channel list)

let port = 
  try int_of_string (Sys.getenv "OCAMLVIZ_PORT")
  with Not_found -> 51000

let period = 
  try float_of_string (Sys.getenv "OCAMLVIZ_PERIOD")
  with Not_found -> 0.1

let init_sock () =
  try
    let sockaddr = ADDR_INET (inet_addr_any, port) in
    setsockopt sock SO_REUSEADDR true;
    bind sock sockaddr;
    listen sock 3
  with Unix.Unix_error _ -> 
    eprintf "run: couldn't run the server\n"; 
    exit 1

let send_string out s =
  Printf.fprintf out "%s" s;
  flush out

let new_client _ =
  let fd,_ = accept sock in
  set_nonblock fd;
  let out = out_channel_of_descr fd in
  Printf.fprintf out "%s" (declare_tags ());
  clients := out :: !clients;
  set_nb_clients (List.length !clients)

let send_data s out = 
  try
    send_string out s;
  with e -> 
    (* Format.printf "%s@." (Printexc.to_string e);  *)
    clients := List.filter (fun s -> s!=out) !clients;
    set_nb_clients (List.length !clients)

let send () =
  try
    let ready,_,_ = Unix.select [sock] [] [] 0. in
    List.iter new_client ready;
    if !clients <> [] then
      let s = to_send () in
      List.iter (send_data s) !clients;
  with e -> 
    Format.eprintf "send: %s@." (Printexc.to_string e); ()

let mutex = ref false

let collect () =
  while true do
    if not !mutex then begin  
      mutex := true;
      begin try
        send ()
      with e -> 
        Format.eprintf "send: %s@." (Printexc.to_string e); ()
      end;
      mutex := false
    end;
    Thread.delay period
  done

let send_now () =
  if not !mutex && !clients <> [] then begin  
    mutex := true;
    begin try
      let s = to_send () in
      List.iter (send_data s) !clients
    with e -> 
      Format.eprintf "send_now: %s@." (Printexc.to_string e); ()
    end;
    mutex := false
  end

let () =
  init_sock ();
  set_signal sigpipe Signal_ignore
    
let yield () = Thread.yield ()

let _ = Thread.create collect ()

let init () = ()


(*
  Local Variables: 
  compile-command: "unset LANG; make -C .."
  End: 
*)
