98 lines
3.2 KiB
OCaml
98 lines
3.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 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 (_, reg_list) ->
|
|
fold_ahead (fun cur_render_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
|
|
Format.eprintf "Add box %x -- %x@." box_start box_end ;
|
|
let n_render_data, _ = Renderer.add_box_excl
|
|
cur_render_data (box_start, box_end)
|
|
Renderer.(Some {
|
|
box_file = Z.to_int cur_reg.lnr_file;
|
|
box_line = Z.to_int cur_reg.lnr_line;
|
|
box_col = Z.to_int cur_reg.lnr_column;
|
|
})
|
|
in
|
|
n_render_data)
|
|
cur_render_data reg_list)
|
|
render_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 multi_render_data = List.map (fun (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 = add_line_boxes render_data line_info in
|
|
boxed_render_data
|
|
) elf_handles in
|
|
|
|
Format.printf "%s@."
|
|
(Renderer.to_string Html_renderer.render multi_render_data)
|