elf_arrows: add boxes according to debug_lines

src/asm_info.ml

@@ -6,6 +6,8 @@ module S (Annot: Annot_type) = struct
   (** A memory address *)
   type addr_t = int
 
+  module AddrMap = Map.Make(struct type t = addr_t let compare = compare end)
+
   (** A single asm instruction *)
   type asm_instr_t = {
     instr_addr:   addr_t;   (** Memory location of this instruction *)

src/elf_arrows.ml

@@ -34,6 +34,29 @@ let open_elf elf_path =
     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) in
+          n_render_data)
+        cur_render_data reg_list)
+    render_data
+    dwarf_lines
+
 let elf_files = ref []
 let speclist = []
 let parse_anon_arg arg =
@@ -49,11 +72,18 @@ let _ =
       !elf_files
   in
 
-  List.iter (fun (ElfHandle(path, _, static_info, asm)) ->
-      ignore asm ;
+  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
+    ) elf_handles ;
+
+  List.iter (fun (ElfHandle(_, _, static_info, asm)) ->
+      let render_data = Renderer.init_render_data asm in
+      let line_info = static_info.ds_evaluated_line_info in
+      let boxed_render_data = add_line_boxes render_data line_info in
+      Format.printf "%s@."
+        (Renderer.to_string Html_renderer.render boxed_render_data)
+    ) elf_handles;

src/renderer.ml

@@ -13,6 +13,7 @@ type tag_addr_range_t = TaggedRange of addr_range_tag_t * addr_range_t
 type render_data_t = {
   render_prog : RawAsm.asm_info_t ;
   render_boxes : tag_addr_range_t list ;
+  render_prev_address : RawAsm.addr_t RawAsm.AddrMap.t
 }
 
 type render_box_event_t =
@@ -24,15 +25,33 @@ type asm_annot_type = {
 }
 module AnnotAsm = Asm_info.S(struct type instr_annot_t = asm_annot_type end)
 
+(** Make a map mapping addresses to the preceding instruction address appearing
+    in `prog` *)
+let make_prev_address prog =
+  let _, addr_map =
+    List.fold_left (fun (prev_addr, cmap) sub ->
+        List.fold_left (fun (prev_addr, cmap) instr ->
+            (instr.RawAsm.instr_addr,
+             RawAsm.AddrMap.add instr.RawAsm.instr_addr prev_addr cmap)
+          )
+          (prev_addr, cmap)
+          sub.RawAsm.sub_asm
+      )
+      (0, RawAsm.AddrMap.empty)
+      prog
+  in
+  addr_map
+
 (** Initializes a rendering data structure on the given program *)
 let init_render_data prog =
   { render_prog = prog ;
-    render_boxes = []
+    render_boxes = [] ;
+    render_prev_address = make_prev_address prog ;
   }
 
-(** [add_box render_data range] adds a box around an address range in
-    [render_data] and returns the new render data and the newly inserted
-    element's id *)
+(** [add_box render_data range] adds a box around an address range, inclusive
+    of both bounds, in [render_data] and returns the new render data and the
+    newly inserted element's id *)
 let add_box render_data range : render_data_t * int =
   let elt_id = (match render_data.render_boxes with
       | [] -> 0
@@ -43,6 +62,16 @@ let add_box render_data range : render_data_t * int =
     render_boxes = (TaggedRange(elt_id, range)) :: render_data.render_boxes
   }, elt_id
 
+
+(** Same as [add_box], with an included start, excluded end for range. *)
+let add_box_excl render_data (addr_beg, addr_end) =
+  (match RawAsm.AddrMap.find_opt addr_end render_data.render_prev_address with
+   | None -> Format.eprintf "Box end address %x not found, ignoring box."
+               addr_end ;
+            raise Not_found
+   | Some end_bound -> add_box render_data (addr_beg, end_bound)
+  )
+
 (** [to_file renderer render_data path] renders the given [render_data] to a
     file at [path] using the provided specific renderer *)
 let to_file renderer render_data path =