Match asm blocks with debug_line

src/asm_matcher.ml

@@ -0,0 +1,93 @@
+(** Matches lines of assembly according to their DWARF line info *)
+
+type blockid_t = int
+
+module BlockidMap = Map.Make(struct
+    type t = blockid_t
+    let compare = compare
+  end)
+
+type asm_block_info = {
+  asm_bi_dwarfline : Dwarf.line_number_registers ;
+  asm_bi_blockid : blockid_t ;
+}
+
+(** Generates a fresh block id *)
+let fresh_blockid =
+  let next_id = ref 0 in
+  fun () ->
+    let out = !next_id in
+    incr next_id ;
+    out
+
+(** Compares two block infos wrt. class equivalence *)
+let asm_bi_compare blk1 blk2 =
+  let select_file blk = Dwarf.(blk.asm_bi_dwarfline.lnr_file) in
+  let select_line blk = Dwarf.(blk.asm_bi_dwarfline.lnr_line) in
+  let select_col blk = Dwarf.(blk.asm_bi_dwarfline.lnr_column) in
+
+  match compare (select_file blk1) (select_file blk2) with
+  | 0 -> (match compare (select_line blk1) (select_line blk2) with
+      | 0 -> compare (select_col blk1) (select_col blk2)
+      | n -> n)
+  | n -> n
+
+module BoxRootSet = Set.Make(struct
+    type t = asm_block_info
+    let compare = asm_bi_compare
+  end)
+
+type matcher_state_t = {
+  ms_block_infos : asm_block_info BlockidMap.t ;
+  ms_block_classes : blockid_t BlockidMap.t ;
+  ms_block_roots : BoxRootSet.t;
+}
+
+let empty_state = {
+  ms_block_infos = BlockidMap.empty ;
+  ms_block_classes = BlockidMap.empty ;
+  ms_block_roots = BoxRootSet.empty ;
+}
+
+(** Add a new block to the state, returning the new state and the class id of
+    the added block *)
+let add_block_bi state blockinfo =
+  match BoxRootSet.find_opt blockinfo state.ms_block_roots with
+  | None ->
+    {
+      ms_block_infos = BlockidMap.add
+          blockinfo.asm_bi_blockid
+          blockinfo
+          state.ms_block_infos ;
+      ms_block_classes = BlockidMap.add
+          blockinfo.asm_bi_blockid
+          blockinfo.asm_bi_blockid
+          state.ms_block_classes ;
+      ms_block_roots = BoxRootSet.add blockinfo state.ms_block_roots ;
+    }, blockinfo.asm_bi_blockid
+  | Some root_block ->
+    { state with
+      ms_block_infos = BlockidMap.add
+          blockinfo.asm_bi_blockid
+          blockinfo
+          state.ms_block_infos ;
+      ms_block_classes = BlockidMap.add
+          blockinfo.asm_bi_blockid
+          root_block.asm_bi_blockid
+          state.ms_block_classes ;
+    }, root_block.asm_bi_blockid
+
+(** Same as [add_block_bi], but takes simply a [Dwarf.line_number_registers] as 
+    argument and generates a fresh id by itself.
+    WARNING! Do not mix automatically and manually generated ids.
+*)
+let add_block state lnr =
+  add_block_bi state {
+    asm_bi_dwarfline = lnr ;
+    asm_bi_blockid = fresh_blockid ()
+  }
+
+(** Gets the class ID of a previously added blockinfo. If the blockinfo was
+    never added, raises Not_found. *)
+let block_class state blockinfo =
+  BlockidMap.find blockinfo.asm_bi_blockid state.ms_block_classes

src/elf_arrows.ml

@@ -35,7 +35,7 @@ let open_elf elf_path =
 
 
 (** Add boxes according to DWARF info *)
-let add_line_boxes render_data dwarf_lines =
+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
@@ -45,22 +45,25 @@ let add_line_boxes render_data dwarf_lines =
     do_fold base lst
   in
 
-  List.fold_left (fun cur_render_data (_, reg_list) ->
-      fold_ahead (fun cur_render_data cur_reg reg_ahead ->
+  List.fold_left (fun (cur_render_data, cur_matcher_data) (_, 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
           Format.eprintf "Add box %x -- %x@." box_start box_end ;
+          let n_matcher_data, block_class_id =
+            Asm_matcher.add_block cur_matcher_data cur_reg in
           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;
+                box_class_id = block_class_id;
               })
           in
-          n_render_data)
-        cur_render_data reg_list)
-    render_data
+          (n_render_data, n_matcher_data))
+        (cur_render_data, cur_matcher_data) reg_list)
+    (render_data, matcher_data)
     dwarf_lines
 
 let elf_files = ref []
@@ -78,6 +81,7 @@ let _ =
       !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@."
@@ -85,13 +89,24 @@ let _ =
         (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
+  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)

src/html_renderer.ml

@@ -26,8 +26,8 @@ let render_prog_box annotated_prog = Jingoo.Jg_types.(Renderer.AnnotAsm.(
                      ("typ", box_string typ);
                      ("id", box_int id);
                      ("bound", box_string @@ render_addr bound);
-                     ("data", box_string @@ Format.sprintf "File %d, %d:%d"
-                        data.box_file data.box_line data.box_col);
+                     ("data", box_string @@ Format.sprintf "[%d] File %d, %d:%d"
+                        data.box_class_id data.box_file data.box_line data.box_col);
 
                    ] |> box_obj)
                    row.instr_annot.Renderer.events)

src/renderer.ml

@@ -11,16 +11,22 @@ type box_data_t = {
   box_file : int;
   box_line : int;
   box_col : int;
+  box_class_id : int;
 }
 type addr_range_tag_t = int
 type tag_addr_range_t = TaggedRange of addr_range_tag_t * addr_range_t *
                                        box_data_t
 
+module RangeTagMap = Map.Make(struct
+    type t = addr_range_tag_t
+    let compare = compare
+  end)
+
 type render_data_t = {
   render_prog_path : string ;
   render_prog : RawAsm.asm_info_t ;
   render_boxes : tag_addr_range_t list ;
-  render_prev_address : RawAsm.addr_t RawAsm.AddrMap.t
+  render_prev_address : RawAsm.addr_t RawAsm.AddrMap.t ;
 }
 
 type multi_render_data_t = render_data_t list
@@ -60,20 +66,26 @@ let init_render_data prog path =
     render_prev_address = make_prev_address prog ;
   }
 
+let fresh_box_id =
+  let next_id = ref 0 in
+  fun () ->
+    let out = !next_id in
+    incr next_id;
+    out
+
 (** [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 opt_data : render_data_t * int =
-  let elt_id = (match render_data.render_boxes with
-      | [] -> 0
-      | TaggedRange(prev_id, _, _)::_ -> prev_id + 1) in
+  let elt_id = fresh_box_id () in
 
   let data = (match opt_data with
       | Some data -> data
       | None -> {
           box_file = 0;
           box_line = 0;
-          box_col = 0
+          box_col = 0;
+          box_class_id = 0;
         })
   in
   {