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.
97 lines
2.6 KiB
97 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
|
|
|