Théophile Bastian
e90e51fc2a
It seems possible that two runs of eg. gcc at different levels of optimisation on the same files assigns different IDs to the same files. To circumvent this, we use the file paths instead of file IDs.
121 lines
4.2 KiB
OCaml
121 lines
4.2 KiB
OCaml
(** Entry point file for elf_arrows *)
|
|
|
|
exception NotElf;;
|
|
exception NoDwarf;;
|
|
exception NoDwarfStatic;;
|
|
|
|
let (>>=) = Error.bind
|
|
|
|
let make_pp linksem_pp =
|
|
(fun fmt arg ->
|
|
linksem_pp arg
|
|
|> Format.fprintf fmt "%s")
|
|
|
|
type elf_path = string
|
|
type elf_handle =
|
|
ElfHandle of elf_path * Elf_file.elf_file * Dwarf.dwarf_static
|
|
* Asm_info.NoAnnot.asm_info_t
|
|
|
|
(** Open an ELF file and loads its dwarf_static infos. *)
|
|
let open_elf elf_path =
|
|
|
|
(Byte_sequence.acquire elf_path >>= fun elf_bs -> (
|
|
match Elf_file.read_elf64_file elf_bs with
|
|
| Error.Success elf64 -> Error.Success (Elf_file.ELF_File_64 elf64)
|
|
| Error.Fail _ -> (match Elf_file.read_elf32_file elf_bs with
|
|
| Error.Success elf32 -> Error.Success (Elf_file.ELF_File_32 elf32)
|
|
| Error.Fail _ -> raise NotElf)
|
|
))
|
|
>>= fun elf_file -> (
|
|
let asm_info = Asm_acquire.acquire_asm elf_path in
|
|
let static_info = (match Dwarf.extract_dwarf_static elf_file with
|
|
| Some static_info -> static_info
|
|
| None -> raise NoDwarfStatic) in
|
|
Error.Success (ElfHandle (elf_path, elf_file, static_info, asm_info)))
|
|
|
|
|
|
(** Add boxes according to DWARF info *)
|
|
let add_line_boxes render_data matcher_data dwarf_lines =
|
|
(* List.fold_left with two elements in scope at once. *)
|
|
let fold_ahead folder base lst =
|
|
let rec do_fold accu = function
|
|
| [] | _::[] -> accu
|
|
| hd1::hd2::tl -> do_fold (folder accu hd1 hd2) (hd2::tl)
|
|
in
|
|
do_fold base lst
|
|
in
|
|
|
|
List.fold_left (fun (cur_render_data, cur_matcher_data)
|
|
(reg_header, reg_list) ->
|
|
fold_ahead (fun (cur_render_data, cur_matcher_data) cur_reg reg_ahead ->
|
|
let box_start = Z.to_int @@ cur_reg.Dwarf.lnr_address in
|
|
let box_end = Z.to_int @@ reg_ahead.Dwarf.lnr_address in
|
|
(match box_start = box_end with
|
|
| true -> cur_render_data, cur_matcher_data
|
|
| false ->
|
|
Format.eprintf "Add box %x -- %x@." box_start box_end ;
|
|
let n_matcher_data, block_class_id =
|
|
Asm_matcher.add_block cur_matcher_data reg_header cur_reg in
|
|
let file_name = (
|
|
let file_id = cur_reg.lnr_file
|
|
|> Z.to_int in
|
|
Asm_matcher.extract_file_name file_id reg_header.lnh_file_names
|
|
) in
|
|
let n_render_data, _ = Renderer.add_box_excl
|
|
cur_render_data (box_start, box_end)
|
|
Renderer.(Some {
|
|
box_file = file_name ;
|
|
box_line = Z.to_int cur_reg.lnr_line;
|
|
box_col = Z.to_int cur_reg.lnr_column;
|
|
box_class_id = block_class_id;
|
|
})
|
|
in
|
|
(n_render_data, n_matcher_data))
|
|
)
|
|
(cur_render_data, cur_matcher_data) reg_list)
|
|
(render_data, matcher_data)
|
|
dwarf_lines
|
|
|
|
let elf_files = ref []
|
|
let speclist = []
|
|
let parse_anon_arg arg =
|
|
elf_files := arg :: (!elf_files)
|
|
|
|
let _ =
|
|
Arg.parse speclist parse_anon_arg "./test ELF_FILE" ;
|
|
let elf_handles = List.rev @@
|
|
List.map (fun path -> match open_elf path with
|
|
| Error.Success handle -> handle
|
|
| Error.Fail msg ->
|
|
raise (Failure ("Could not open " ^ path ^ ": " ^ msg)))
|
|
!elf_files
|
|
in
|
|
|
|
List.iter (fun (ElfHandle(path, _, static_info, _)) ->
|
|
let line_info = static_info.ds_evaluated_line_info in
|
|
Format.eprintf "Line infos <%s>:@. %a@."
|
|
path
|
|
(make_pp Dwarf.pp_evaluated_line_info)
|
|
line_info ;
|
|
) elf_handles ;
|
|
|
|
let map_with_state mapper initial_state lst =
|
|
List.fold_right (fun elt (cur_state, accu) ->
|
|
let n_state, mapped_elt = mapper cur_state elt in
|
|
n_state, mapped_elt::accu)
|
|
lst
|
|
(initial_state, [])
|
|
in
|
|
|
|
let _, multi_render_data = map_with_state
|
|
(fun matcher_state (ElfHandle(path, _, static_info, asm)) ->
|
|
let render_data = Renderer.init_render_data asm path in
|
|
let line_info = static_info.ds_evaluated_line_info in
|
|
let boxed_render_data, n_matcher_state =
|
|
add_line_boxes render_data matcher_state line_info in
|
|
n_matcher_state, boxed_render_data
|
|
) Asm_matcher.empty_state elf_handles in
|
|
|
|
Format.printf "%s@."
|
|
(Renderer.to_string Html_renderer.render multi_render_data)
|