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
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
|