You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

98 lines
2.6 KiB

let trace_path = Sys.argv.(1)
let index_path = trace_path ^ ".idx"
let read_int32 ic =
let b0 = input_byte ic in
let b1 = input_byte ic in
let b2 = input_byte ic in
let b3 = input_byte ic in
Int32.(
logor (shift_left (of_int b0) 0) @@
logor (shift_left (of_int b1) 8) @@
logor (shift_left (of_int b2) 16) @@
(shift_left (of_int b3) 24)
)
let read_int64 ic =
let b0 = input_byte ic in
let b1 = input_byte ic in
let b2 = input_byte ic in
let b3 = input_byte ic in
let b4 = input_byte ic in
let b5 = input_byte ic in
let b6 = input_byte ic in
let b7 = input_byte ic in
Int64.(
logor (shift_left (of_int b0) 0) @@
logor (shift_left (of_int b1) 8) @@
logor (shift_left (of_int b2) 16) @@
logor (shift_left (of_int b3) 24) @@
logor (shift_left (of_int b4) 32) @@
logor (shift_left (of_int b5) 40) @@
logor (shift_left (of_int b6) 48) @@
(shift_left (of_int b7) 56)
)
let index =
let read_entry ic =
let length = Int32.to_int @@ read_int32 ic in
assert (length > 4);
let index = Int32.to_int @@ read_int32 ic in
let name = really_input_string ic (length - 4) in
(index, name)
in
let read_entries ic =
let entries = ref [] in
(try
while true do
let entry = read_entry ic in
entries := entry :: !entries;
done
with End_of_file -> ());
!entries
in
let make_index entries =
let table = Array.make (List.length entries) "" in
List.iter (fun (index, name) ->
assert (index >= 1024);
table.(index - 1024) <- name
) entries;
table
in
let ic = open_in_bin index_path in
let entries = read_entries ic in
close_in_noerr ic;
make_index entries
let () =
let ic = open_in_bin trace_path in
let fold_event ic f acc =
let read_event ic =
let atom = Int32.to_int @@ read_int32 ic in
let sp = read_int32 ic in
let time = read_int64 ic in
(index.(atom - 1024), sp, time)
in
let acc = ref acc in
try
while true do acc := f !acc (read_event ic) done;
!acc
with End_of_file -> !acc
in
let rec add_sp (sp : int32) time1 time0 = function
| (sp', time0) :: rest when sp >= sp' ->
add_sp sp time1 time0 rest
| sps -> ((sp, time1) :: sps, Int64.sub time1 time0)
in
let _ =
fold_event ic (fun lastsps (atom, sp, time) ->
let lastsps, delta = add_sp sp time time lastsps in
let indent = String.make (List.length lastsps) ' ' in
if delta > 0L then
print_endline (indent ^ Int64.to_string delta ^ " ns");
print_endline (indent ^ "- " ^ atom);
lastsps
) []
in
close_in_noerr ic