Use AddrMap instead of CfaChange list

DwarfSynth/Frontend.ml

@@ -10,7 +10,7 @@ let pp_int64_hex ppx number =
   List.iter pp_short @@ List.map (fun x ->
       Int64.(shift_right number (16*x))) [3;2;1;0]
 
-let pp_cfa_change ppx (Simplest.CfaChange (addr, pos)) = Simplest.(
+let pp_cfa_change ppx addr pos = Simplest.(
     let num_len num =
       let str_rep = Format.sprintf "%+d" num in
       String.length str_rep
@@ -34,11 +34,9 @@ let pp_cfa_change ppx (Simplest.CfaChange (addr, pos)) = Simplest.(
 let pp_pre_dwarf_readelf ppx pre_dwarf =
   Simplest.StrMap.iter (fun fde_name entry ->
       Format.fprintf ppx "FDE %s@." fde_name ;
-      (match entry with
+      if not (Simplest.AddrMap.is_empty entry) then (
-       | [] -> ()
-       | _ ->
          Format.fprintf ppx "   LOC           CFA      ra@." ;
-         List.iter (pp_cfa_change ppx) entry ;
+         Simplest.AddrMap.iter (pp_cfa_change ppx) entry ;
          Format.fprintf ppx "@.")
     )
     pre_dwarf

DwarfSynth/Simplest.ml

@@ -12,9 +12,7 @@ type cfa_pos =
   | RbpOffset of memory_offset
   | CfaLostTrack
 
-type cfa_change = CfaChange of memory_address * cfa_pos
+type cfa_changes_fde = cfa_pos AddrMap.t
-
-type cfa_changes_fde = cfa_change list
 
 module StrMap = Map.Make(String)
 type cfa_changes = cfa_changes_fde StrMap.t
@@ -36,11 +34,12 @@ let pp_int64_hex ppx number =
   List.iter pp_short @@ List.map (fun x ->
       Int64.(shift_right number (16*x))) [3;2;1;0]
 
-let pp_cfa_change ppx = function CfaChange(addr, cfa_pos) ->
+let pp_cfa_changes_fde ppx cfa_changes = AddrMap.iter
-  Format.fprintf ppx "%a: %a" pp_int64_hex addr pp_cfa_pos cfa_pos
+    (fun addr change ->
-
+       Format.fprintf ppx "%a: %a@."
-let pp_cfa_changes_fde ppx = List.iter
+         pp_int64_hex addr
-    (Format.fprintf ppx "%a@." pp_cfa_change)
+         pp_cfa_pos change)
+    cfa_changes
 
 let pp_cfa_changes ppx =
   StrMap.iter (fun fde_name entry ->
@@ -259,15 +258,14 @@ let process_blk
     next_instr_graph (block_init: cfa_pos) blk : (cfa_changes_fde * cfa_pos) =
   (** Extracts the CFA changes of a block. *)
 
-  let apply_offset cur_addr_opt ((accu:cfa_change list), cur_cfa) = function
+  let apply_offset cur_addr_opt ((accu:cfa_changes_fde), cur_cfa) = function
     | None -> (accu, cur_cfa)
     | Some pos ->
       let cur_addr = (match cur_addr_opt with
           | None -> assert false
           | Some x -> to_int64_addr x) in
       (AddrSet.fold (fun n_addr cur_accu ->
-           let change = CfaChange(n_addr, pos) in
+           AddrMap.add n_addr pos cur_accu)
-           (change :: cur_accu))
           (AddrMap.find cur_addr next_instr_graph)
           accu),
       pos
@@ -284,10 +282,10 @@ let process_blk
   in
 
   let init_changes = (match opt_addr_of blk with
-      | None -> []
+      | None -> AddrMap.empty
       | Some x ->
         let blk_address = to_int64_addr x in
-        [CfaChange (blk_address, block_init)]
+        AddrMap.singleton blk_address block_init
     ) in
 
   let elts_seq = BStd.Blk.elts blk in
@@ -352,61 +350,35 @@ let process_sub sub : cfa_changes_fde =
   let changes_map = dfs_process TIdMap.empty entry_blk initial_offset in
 
   let merged_changes = TIdMap.fold
-    (fun _ (cfa_changes, _) accu -> cfa_changes @ accu)
+      (fun _ (cfa_changes, _) accu -> AddrMap.union (fun _ v1 v2 ->
+           if v1 = v2 then
+             Some v1
+           else
+             assert false)
+           cfa_changes accu)
     changes_map
-    [] in
+    AddrMap.empty in
 
-  let sorted_changes = List.sort
+  merged_changes
-      (fun (CfaChange (addr1, _)) (CfaChange (addr2, _)) ->
-         compare addr1 addr2)
-      merged_changes
-      in
-
-  sorted_changes
 
 let cleanup_fde (fde_changes: cfa_changes_fde) : cfa_changes_fde =
   (** Cleanup the result of `of_sub`.
 
       Merges entries at the same address, propagates track lost *)
 
-  let fold_one (accu, (last_commit:cfa_pos option), in_flight, lost_track) = function
+  let fold_one addr cfa_change (accu, last_change, lost_track) =
-    | CfaChange(addr, cfa_change) as cur_change -> (
+    match cfa_change, last_change, lost_track with
-        match lost_track, in_flight, cfa_change with
+    | _, _, true -> (accu, None, lost_track)
-        | true, _, _ ->
+    | CfaLostTrack, _, false ->
-          (* Already lost track: give up *)
+      (AddrMap.add addr cfa_change accu, None, true)
-          (accu, last_commit, None, lost_track)
+    | cfa_change, Some prev_change, false when cfa_change = prev_change ->
-        | false, _, CfaLostTrack ->
+      (accu, last_change, false)
-          (* Just lost track: give up the operation on flight as well *)
+    | cfa_change, _, false ->
-          (cur_change :: accu, None, None, true)
+      (AddrMap.add addr cfa_change accu, Some cfa_change, false)
-        | _, Some CfaChange(flight_addr, flight_chg), _
-          when flight_addr = addr ->
-          (* On flight address matches current address: continue flying *)
-            accu, last_commit, Some cur_change, false
-        | _, Some CfaChange(_, in_flight_inner_pos), _
-          when last_commit = Some in_flight_inner_pos ->
-          (* Doesn't match anymore, but there was some operation in flight,
-             which has the same result as what was last committed. Discard. *)
-          (accu, last_commit, Some cur_change, false)
-        | _, Some (CfaChange(_, in_flight_inner_pos) as in_flight_inner), _ ->
-          (* Doesn't match anymore, but there was some operation in flight:
-             commit it, put the new one in flight *)
-          (in_flight_inner :: accu, Some in_flight_inner_pos,
-           Some cur_change, false)
-        | _, None, _ ->
-          (* No operation in flight: put the new one in flight *)
-          (accu, last_commit, Some cur_change, false)
-    )
   in
 
-  let extract_end_value (accu, _, in_flight, lost_track) =
+  match AddrMap.fold fold_one fde_changes (AddrMap.empty, None, false) with
-    List.rev @@ match lost_track, in_flight with
+  | out, _, _ -> out
-    | true, _ -> accu
-    | false, None -> accu
-    | false, Some x -> x :: accu
-  in
-
-  extract_end_value
-    @@ List.fold_left fold_one ([], None, None, false) fde_changes
 
 
 let of_prog prog : cfa_changes =