[sledge] Memoize translation of globals, and handle recursive globals

Summary:
Some globals have initializers which refer to the global
itself (e.g. for program counter relative offsets). Memoizing
translation of globals gives enough machinery to detect and handle
this situation.

Reviewed By: mbouaziz

Differential Revision: D15098819

fbshipit-source-id: ecc9dce92

sledge/src/llair/frontend.ml

@@ -304,6 +304,9 @@ let xlate_name_opt : Llvm.llvalue -> Var.t option =
 
 let memo_value : (Llvm.llvalue, Exp.t) Hashtbl.t = Hashtbl.Poly.create ()
 
+let memo_global : (Llvm.llvalue, Global.t) Hashtbl.t =
+  Hashtbl.Poly.create ()
+
 module Llvalue = struct
   type t = Llvm.llvalue
 
@@ -593,27 +596,27 @@ and xlate_opcode : x -> Llvm.llvalue -> Llvm.Opcode.t -> Exp.t =
 
 and xlate_global : x -> Llvm.llvalue -> Global.t =
  fun x llg ->
-  let init =
+  Hashtbl.find_or_add memo_global llg ~default:(fun () ->
-    match (Llvm.classify_value llg, Llvm.linkage llg) with
+      [%Trace.call fun {pf} -> pf "%a" pp_llvalue llg]
-    | _, (External | External_weak) -> None
+      ;
-    | GlobalVariable, _ ->
+      let g = xlate_name llg in
-        Some (xlate_value x (Llvm.global_initializer llg))
+      let llt = Llvm.type_of llg in
-    | _ -> None
+      let typ = xlate_type x llt in
-  in
+      let siz = size_of x llt in
-  let g = xlate_name llg in
+      let loc = find_loc llg in
-  let llt = Llvm.type_of llg in
+      (* add to tbl without initializer in case of recursive occurrences in
-  let typ = xlate_type x llt in
+         its own initializer *)
-  let siz = size_of x llt in
+      Hashtbl.set memo_global ~key:llg ~data:(Global.mk g siz typ loc) ;
-  let loc = find_loc llg in
+      let init =
-  Global.mk g ?init siz typ loc
+        match (Llvm.classify_value llg, Llvm.linkage llg) with
-
+        | _, (External | External_weak) -> None
-let xlate_global : x -> Llvm.llvalue -> Global.t =
+        | GlobalVariable, _ ->
- fun x llg ->
+            Some (xlate_value x (Llvm.global_initializer llg))
-  [%Trace.call fun {pf} -> pf "%a" pp_llvalue llg]
+        | _ -> None
-  ;
+      in
-  xlate_global x llg
+      Global.mk ?init g siz typ loc
-  |>
+      |>
-  [%Trace.retn fun {pf} -> pf "%a" Global.pp]
+      [%Trace.retn fun {pf} -> pf "%a" Global.pp] )
 
 type pop_thunk = Loc.t -> Llair.inst list
 
@@ -1358,6 +1361,7 @@ let translate : string -> Llair.t =
   Hashtbl.clear scope_tbl ;
   Hashtbl.clear anon_struct_name ;
   Hashtbl.clear memo_type ;
+  Hashtbl.clear memo_global ;
   Hashtbl.clear memo_value ;
   Hash_set.clear ignored_callees ;
   Llvm.dispose_module llmodule ;