From aaf0921d867f916320746337b2d23bea3824232d Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Mon, 8 Feb 2021 13:11:23 -0800 Subject: [PATCH] [sledge] Do not regenerate symbol name when updating loc in Frontend Summary: Sometimes symbols are added to the symbol table multiple times during translation from LLVM to LLAIR. For example, this happens when a `llvm.dbg.declare` instruction is encountered that attaches a debug location to a symbol. Currently when this happens, the symbol name is regenerated unnecessarily. This is not economical, and since counters are used in some cases to avoid clashes, this can cause visible changes to names. This diff fixes this, and also makes the location update more robust by not relying on the location added last being the best. Reviewed By: jvillard Differential Revision: D26250542 fbshipit-source-id: 5d52ce193 --- sledge/cli/frontend.ml | 96 ++++++++++++++++-------------- sledge/nonstdlib/hashTable.ml | 3 +- sledge/nonstdlib/hashTable_intf.ml | 1 + 3 files changed, 54 insertions(+), 46 deletions(-) diff --git a/sledge/cli/frontend.ml b/sledge/cli/frontend.ml index fb634e8de..7578367be 100644 --- a/sledge/cli/frontend.ml +++ b/sledge/cli/frontend.ml @@ -123,51 +123,57 @@ open struct in match maybe_scope with | None -> () - | Some scope -> - let next, void_tbl = - ScopeTbl.find_or_add scope_tbl scope ~default:(fun () -> - (ref 0, String.Tbl.create ()) ) - in - let name = - if - Poly.( - Llvm.classify_value llv = Instruction Call - && Llvm.classify_type (Llvm.type_of llv) = Void) - then ( - (* LLVM does not give unique names to the result of - void-returning function calls. We need unique names for - these as they determine the labels of newly-created return - blocks. *) - let fname = - match - Llvm.(value_name (operand llv (num_operands llv - 1))) - with - | "" -> Int.to_string (!next - 1) - | s -> s - in - match String.Tbl.find void_tbl fname with - | None -> - String.Tbl.set void_tbl ~key:fname ~data:1 ; - fname ^ ".void" - | Some count -> - String.Tbl.set void_tbl ~key:fname ~data:(count + 1) ; - String.concat ~sep:"" - [fname; ".void."; Int.to_string count] ) - else - match Llvm.value_name llv with - | "" -> - (* anonymous values take the next SSA name *) - let name = !next in - next := name + 1 ; - Int.to_string name - | name -> ( - match Int.of_string name with - | Some _ -> - (* escape to avoid clash with names of anonymous values *) - "\"" ^ name ^ "\"" - | None -> name ) - in - SymTbl.set sym_tbl ~key:llv ~data:(name, loc) + | Some scope -> ( + match SymTbl.find sym_tbl llv with + | Some (name, loc0) -> + if Loc.equal loc0 Loc.none then + SymTbl.set sym_tbl ~key:llv ~data:(name, loc) + | None -> + let next, void_tbl = + ScopeTbl.find_or_add scope_tbl scope ~default:(fun () -> + (ref 0, String.Tbl.create ()) ) + in + let name = + if + Poly.( + Llvm.classify_value llv = Instruction Call + && Llvm.classify_type (Llvm.type_of llv) = Void) + then ( + (* LLVM does not give unique names to the result of + void-returning function calls. We need unique names for + these as they determine the labels of newly-created + return blocks. *) + let fname = + match + Llvm.(value_name (operand llv (num_operands llv - 1))) + with + | "" -> Int.to_string (!next - 1) + | s -> s + in + match String.Tbl.find void_tbl fname with + | None -> + String.Tbl.set void_tbl ~key:fname ~data:1 ; + fname ^ ".void" + | Some count -> + String.Tbl.set void_tbl ~key:fname ~data:(count + 1) ; + String.concat ~sep:"" + [fname; ".void."; Int.to_string count] ) + else + match Llvm.value_name llv with + | "" -> + (* anonymous values take the next SSA name *) + let name = !next in + next := name + 1 ; + Int.to_string name + | name -> ( + match Int.of_string name with + | Some _ -> + (* escape to avoid clash with names of anonymous + values *) + "\"" ^ name ^ "\"" + | None -> name ) + in + SymTbl.set sym_tbl ~key:llv ~data:(name, loc) ) end let scan_names_and_locs : Llvm.llmodule -> unit = diff --git a/sledge/nonstdlib/hashTable.ml b/sledge/nonstdlib/hashTable.ml index 67fb5cebc..00656694c 100644 --- a/sledge/nonstdlib/hashTable.ml +++ b/sledge/nonstdlib/hashTable.ml @@ -21,12 +21,13 @@ module Make (Key : HashedType) = struct update tbl ~k:key ~f:(fun _ -> function | None -> Some [data] | Some datas -> Some (data :: datas) ) + let update tbl key ~f = update tbl ~k:key ~f:(fun _ dat -> f dat) let find_exn = find let find = find_opt let find_or_add tbl key ~default = let found = ref None in - update tbl ~k:key ~f:(fun _ -> function + update tbl key ~f:(function | None -> let v = default () in found := Some v ; diff --git a/sledge/nonstdlib/hashTable_intf.ml b/sledge/nonstdlib/hashTable_intf.ml index 21767961b..e9ee94859 100644 --- a/sledge/nonstdlib/hashTable_intf.ml +++ b/sledge/nonstdlib/hashTable_intf.ml @@ -15,6 +15,7 @@ module type S = sig val create : ?size:int -> unit -> 'a t val set : 'a t -> key:key -> data:'a -> unit val add_multi : 'a list t -> key:key -> data:'a -> unit + val update : 'a t -> key -> f:('a option -> 'a option) -> unit val find_exn : 'a t -> key -> 'a val find : 'a t -> key -> 'a option val find_or_add : 'a t -> key -> default:(unit -> 'a) -> 'a