From d5158f0787872385aba51d9fff6e36754b3c5117 Mon Sep 17 00:00:00 2001
From: Josh Berdine <jjb@fb.com>
Date: Tue, 10 Mar 2020 02:21:33 -0700
Subject: [PATCH] [sledge] Move Reg.demangle to frontend

Summary:
`Reg.demangle` is implemented by calling the `_cxa_demangle` C++
runtime system function. This will be linked into the sledge binary,
due to being linked with llvm, but will not necessarily be available
in the sledge library. So make it a dynamically-set function to avoid
calling an undefined function from the library.

Reviewed By: jvillard

Differential Revision: D20323791

fbshipit-source-id: bda9afd37
---
 sledge/src/llair/exp.ml      | 19 ++-----------------
 sledge/src/llair/exp.mli     |  1 +
 sledge/src/llair/frontend.ml | 18 ++++++++++++++++++
 3 files changed, 21 insertions(+), 17 deletions(-)

diff --git a/sledge/src/llair/exp.ml b/sledge/src/llair/exp.ml
index cc387831e..767b8a449 100644
--- a/sledge/src/llair/exp.ml
+++ b/sledge/src/llair/exp.ml
@@ -339,27 +339,12 @@ module Reg = struct
     let empty = Map.empty (module T)
   end
 
-  let demangle =
-    let open Ctypes in
-    let cxa_demangle =
-      (* char *__cxa_demangle(const char *, char *, size_t *, int * ) *)
-      Foreign.foreign "__cxa_demangle"
-        ( string @-> ptr char @-> ptr size_t @-> ptr int
-        @-> returning string_opt )
-    in
-    let null_ptr_char = from_voidp char null in
-    let null_ptr_size_t = from_voidp size_t null in
-    let status = allocate int 0 in
-    fun mangled ->
-      let demangled =
-        cxa_demangle mangled null_ptr_char null_ptr_size_t status
-      in
-      if !@status = 0 then demangled else None
+  let demangle = ref (fun _ -> None)
 
   let pp_demangled fs e =
     match e.desc with
     | Reg {name} -> (
-      match demangle name with
+      match !demangle name with
       | Some demangled when not (String.equal name demangled) ->
           Format.fprintf fs "“%s”" demangled
       | _ -> () )
diff --git a/sledge/src/llair/exp.mli b/sledge/src/llair/exp.mli
index 30e5ff13e..5adba08a3 100644
--- a/sledge/src/llair/exp.mli
+++ b/sledge/src/llair/exp.mli
@@ -125,6 +125,7 @@ module Reg : sig
     val empty : 'a t
   end
 
+  val demangle : (string -> string option) ref
   val pp : t pp
   val pp_demangled : t pp
 
diff --git a/sledge/src/llair/frontend.ml b/sledge/src/llair/frontend.ml
index 5338f18f1..07078cfaf 100644
--- a/sledge/src/llair/frontend.ml
+++ b/sledge/src/llair/frontend.ml
@@ -15,6 +15,24 @@ let pp_llvalue fs t = Format.pp_print_string fs (Llvm.string_of_llvalue t)
 let pp_llblock fs t =
   Format.pp_print_string fs (Llvm.string_of_llvalue (Llvm.value_of_block t))
 
+;;
+Reg.demangle :=
+  let open Ctypes in
+  let cxa_demangle =
+    (* char *__cxa_demangle(const char *, char *, size_t *, int * ) *)
+    Foreign.foreign "__cxa_demangle"
+      ( string @-> ptr char @-> ptr size_t @-> ptr int
+      @-> returning string_opt )
+  in
+  let null_ptr_char = from_voidp char null in
+  let null_ptr_size_t = from_voidp size_t null in
+  let status = allocate int 0 in
+  fun mangled ->
+    let demangled =
+      cxa_demangle mangled null_ptr_char null_ptr_size_t status
+    in
+    if !@status = 0 then demangled else None
+
 exception Invalid_llvm of string
 
 let invalid_llvm : string -> 'a =