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