(**************************************************************************)
(*                                                                        *)
(*  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                                          *)
(*                                                                        *)
(**************************************************************************)

(** Imperative implementation.

    Uses two arrays, [time] for keys (timestamps) and [data] for associated
    values. (This is more efficient than an array of pairs.)

    The arrays are used circularly, elements being stored from first
    to first+n (modulo the size of arrays)

    +-----------------------------------------------------+
    |             |.......n elements.......|              |
    +-----------------------------------------------------+
                   ^                        ^
                 first                   first+n

*)

type 'a t = {
  mutable time : float array;
  mutable data : 'a array;
  mutable size : int;  (* size of arrays [time] and [data] *)
  mutable first : int; (* position of the first (least recent) element *)
  mutable n : int;     (* number of elements *)
}


let tmin = ref 0.

let create ?(size=10) x =
  if size <= 0 then invalid_arg "Timemap.create";
  { time = Array.make size 0.;
    data = Array.make size x;
    size = size;
    first = 0;
    n = 1;
  }

(* let print_tmap tm =  *)
(* let borne = if (tm.first+tm.n) < tm.size then tm.first+tm.n-1 else size - 1 in*)
(* for i= tm.first to borne do *)
(*     Format.eprintf "tm %d t:%f@." i tm.time.(i) *)
(*   done *)
(* () *)

(* blit a1[ofs1...ofs1+len-1] into a2[0..len-1], with ofs1...ofs1+len-1
   possibly wrapping around the array a1 *)
let circ_blit a1 ofs1 a2 len =
  let len1 = Array.length a1 in
  assert (0 <= ofs1 && ofs1 < len1 && len <= len1 && len <= Array.length a2);
  if ofs1 + len <= len1 then 
    (* a single chunk *)
    Array.blit a1 ofs1 a2 0 len
  else begin
    (* two chunks *)
    let len0 = len1 - ofs1 in
    Array.blit a1 ofs1 a2 0    len0;
    Array.blit a1 0    a2 len0 (len - len0)
  end

(* double the size of [tm] *)
let grow tm =
  if tm.size = Sys.max_array_length then failwith "Timemap.add: cannot grow";
  let newsize = min Sys.max_array_length (2 * tm.size) in
  let newtime = Array.make newsize 0. in
  circ_blit tm.time tm.first newtime tm.n;
  let newdata = Array.make newsize tm.data.(0) in
  circ_blit tm.data tm.first newdata tm.n;
  tm.time <- newtime;
  tm.data <- newdata;
  tm.first <- 0;
  tm.size <- newsize

let add tm t d =
  if tm.n = tm.size then grow tm;
  let i = (tm.first + tm.n) mod tm.size in
  tm.time.(i) <- t;
  tm.data.(i) <- d;
  tm.n <- tm.n + 1

(** finds the index of the most recent element in [tm] with time smaller
    or equal to [t] *)
let find_index tm t =
  if tm.n = 0 || tm.time.(tm.first) > t then 
    begin 
      (* Format.eprintf "t:%f n:%d size:%d@." t tm.n tm.size;  *)
      raise Not_found 
    end ;
  let size = tm.size in
  let rec binary_search lo hi =
    assert (lo <= hi && tm.time.(lo mod size) <= t);
    if lo = hi then 
      lo mod size
    else if lo = hi - 1 then
      if tm.time.(hi mod size) > t then lo mod size else hi mod size
    else
      let mid = lo + (hi - lo) / 2 in
      if tm.time.(mid mod size) > t then (* implies mid > lo *)
	binary_search lo (mid - 1)
      else
	binary_search mid hi
  in
  binary_search tm.first (tm.first + tm.n - 1) 

(** [find tm t] returns the most recent pair [(t',v')] in [tm] 
    with [t'] smaller or equal than [t];
    raises [Not_found] if [tm] contains no element or if the
    first element of [tm] is younger than [t] *)
let find tm t =
  try
    let i = find_index tm t in
    tm.time.(i), tm.data.(i)
  with Not_found ->
    Format.eprintf "find not_found t:%f@." t;(* print_tmap tm; *) assert false


let find_before tm t = 
  let tfirst = tm.first in
  let tsize = tm.size in
  let i = find_index tm t in
  if i < tfirst 
  then 
    begin
      let size = tsize - tfirst in
      let ta = Array.sub tm.time tfirst size in
      let da = Array.sub tm.data tfirst size in
      Array.blit tm.time 0 ta (size+1) i;
      Array.blit tm.data 0 da (size+1) i;
      ta,da
    end
  else 
    begin
      let size = i - tfirst + 1 in
      let ta = Array.sub tm.time tfirst size in
      let da = Array.sub tm.data tfirst size in
      ta,da
    end

  
  
(** removes all entries younger than [t] in [tm] *)
let remove_before tm t =
  (* Format.eprintf "remove t:%f before@. first:%d n:%d size:%d@." t tm.first tm.n tm.size; *)
  (* print_tmap tm; *)
  if t > !tmin then tmin := t;
  try
    let i = find_index tm t in
    let removed = 
      let i = if i < tm.first then i + tm.size  else i in
      i - tm.first
    in
    tm.first <- i mod tm.size;
    tm.n <- tm.n - removed;
    if tm.n = 0
    then
      add tm tm.time.(i) tm.data.(i)
  with Not_found ->
    ()

    
let get_min () = !tmin


 

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