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

exception IncompleteMessage


let buf_int8 buf i =
  Buffer.add_char buf (char_of_int (i land 255))

let get_uint8 s pos = 
  int_of_char s.[pos]
  

let buf_list8 buf_item b list =
  let len = List.length list in
  buf_int8 b len;
  List.iter (buf_item b) list
        
let buf_bool buf b =  buf_int8 buf (if b then 1 else 0)

let get_bool s pos = (get_uint8 s pos) <> 0

let get_bool_pos s pos = (get_uint8 s pos) <> 0, pos+1

let buf_int16 buf i =
  Buffer.add_char buf (char_of_int (i land 255));
  Buffer.add_char buf (char_of_int ((i lsr 8) land 255))

let buf_int24 buf i =
  Buffer.add_char buf (char_of_int (i land 255));
  Buffer.add_char buf (char_of_int ((i lsr 8) land 255));
  Buffer.add_char buf (char_of_int ((i lsr 16) land 255))

let str_int16 s pos i =
  s.[pos] <- char_of_int (i land 255);
  s.[pos+1] <- char_of_int ((i lsr 8) land 255)

let get_int16 s pos =
  let c1 = int_of_char s.[pos] in
  let c2 = int_of_char s.[pos+1] in
  c1 lor (c2 lsl 8), pos + 2
  
let str_int24 s pos i =
  s.[pos] <- char_of_int (i land 255);
  s.[pos+1] <- char_of_int ((i lsr 8) land 255);
  s.[pos+2] <- char_of_int ((i lsr 16) land 255)

let get_int24 s pos =
  let c1 = int_of_char s.[pos] in
  let c2 = int_of_char s.[pos+1] in
  let c3 = int_of_char s.[pos+2] in
  c1 lor (c2 lsl 8) lor (c3 lsl 16), pos + 3

let buf_int31 buf i = 
  buf_int8 buf i;
  buf_int8 buf (i lsr 8);
  buf_int8 buf (i lsr 16); 
  let x = i lsr 24 in
  buf_int8 buf (x lor ((x lsl 1) land 0x80))

let buf_int63 buf i = 
  buf_int8 buf i;
  buf_int8 buf (i lsr 8);
  buf_int8 buf (i lsr 16); 
  buf_int8 buf (i lsr 24); 
  buf_int8 buf (i lsr 32); 
  buf_int8 buf (i lsr 40); 
  buf_int8 buf (i lsr 48); 
  let x = i lsr 56 in
  buf_int8 buf (x lor ((x lsl 1) land 0x80))

let str_int31 s pos i =
  s.[pos] <- char_of_int (i land 255);
  s.[pos+1] <- char_of_int ((i lsr 8) land 255);
  s.[pos+2] <- char_of_int ((i lsr 16) land 255);
  s.[pos+3] <- char_of_int ((i lsr 24) land 255)

let get_int31 s pos =
  let c1 = get_uint8 s pos in
  let c2 = get_uint8 s (pos+1) in
  let c3 = get_uint8 s (pos+2) in
  let c4 = get_uint8 s (pos+3) in
  let x =   c1 lor (c2 lsl 8) lor (c3 lsl 16) lor (c4 lsl 24) in
  x, pos + 4

let get_int63 s pos =
  let c1 = get_uint8 s pos in
  let c2 = get_uint8 s (pos+1) in
  let c3 = get_uint8 s (pos+2) in
  let c4 = get_uint8 s (pos+3) in
  let c5 = get_uint8 s (pos+4) in
  let c6 = get_uint8 s (pos+5) in
  let c7 = get_uint8 s (pos+6) in
  let c8 = get_uint8 s (pos+7) in
  let x =   c1 lor (c2 lsl 8) lor (c3 lsl 16) lor (c4 lsl 24) 
  lor (c5 lsl 32) lor (c6 lsl 40)lor (c7 lsl 48)lor (c8 lsl 56) in
  x, pos + 8

let get_int63_of_31 s pos =
  let c1 = get_uint8 s pos in
  let c2 = get_uint8 s (pos+1) in
  let c3 = get_uint8 s (pos+2) in
  let c4 = get_uint8 s (pos+3) in
  let x = c1 lor (c2 lsl 8) lor (c3 lsl 16) lor (c4 lsl 24) in
  (x lsl 32) asr 32, pos+4

let buf_string31 buf s =
  buf_int31 buf (String.length s);
  Buffer.add_string buf s


let get_string s pos len =
  try
    String.sub s pos len, pos+len
  with e -> Format.printf "%s  len : %d pos : %d @." (Printexc.to_string e) len pos;assert false




let rec get_list_rec get_item s pos len last left =
  if len = 0 then List.rev left, pos else
  let (item,pos) = get_item s pos last in
  get_list_rec get_item s pos (len-1) last (item :: left)

(*
let get_list8 get_item s pos =
  let len = get_uint8 s pos in
  get_list_rec get_item s (pos+1) len []
*)

let get_list16 get_item s pos last =
  if pos > last-2 then raise IncompleteMessage;
  let len, pos = get_int16 s pos in
  get_list_rec get_item s pos len last []

let buf_list16 buf_item b list =
  let len = List.length list in
  buf_int16 b len;
  List.iter (buf_item b) list



let mask_16_bits = Int64.of_int 0xffff

let int64_low16 n = Int64.to_int (Int64.logand n mask_16_bits)

let buf_int64 buf n =
  buf_int16 buf (int64_low16 n);
  buf_int16 buf (int64_low16 (Int64.shift_right n 16));
  buf_int16 buf (int64_low16 (Int64.shift_right n 32));
  buf_int16 buf (int64_low16 (Int64.shift_right n 48))
    
let get_int64 s pos =
  let n0, pos = get_int16 s pos in
  let n1, pos = get_int16 s pos in
  let n2, pos = get_int16 s pos in
  let n3, pos = get_int16 s pos in
  Int64.logor 
    (Int64.logor 
       (Int64.shift_left (Int64.of_int n3) 48)
       (Int64.shift_left (Int64.of_int n2) 32))
    (Int64.logor 
       (Int64.shift_left (Int64.of_int n1) 16)
       (Int64.of_int n0)),
  pos

let get_int64_of_63 s pos =
  get_int64 s pos

let buf_float buf f =
  buf_int64 buf (Int64.bits_of_float f)

let get_float s pos =
  let n, pos = get_int64 s pos in
  Int64.float_of_bits n, pos

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