From 917cc62e280950aa2cc4e7ae785f1fd68cef6fc9 Mon Sep 17 00:00:00 2001
From: Josh Berdine <jjb@fb.com>
Date: Thu, 10 Oct 2019 06:17:16 -0700
Subject: [PATCH] [sledge] Fix type of functions called using a cast

Summary:
For function calls where the callee is a cast expression, previous the
wrong type would be used for the callee. This could lead to crashes in
llvm, or asserting in sledge.

Reviewed By: bennostein

Differential Revision: D17725610

fbshipit-source-id: 938b49a49
---
 sledge/src/llair/frontend.ml | 20 ++++++++++++--------
 1 file changed, 12 insertions(+), 8 deletions(-)

diff --git a/sledge/src/llair/frontend.ml b/sledge/src/llair/frontend.ml
index 026d94f99..ee810f979 100644
--- a/sledge/src/llair/frontend.ml
+++ b/sledge/src/llair/frontend.ml
@@ -850,10 +850,10 @@ let xlate_instr :
       let len = Exp.integer Typ.siz (Z.of_int (size_of x llt)) in
       emit_inst (Llair.Inst.alloc ~reg ~num ~len ~loc)
   | Call -> (
+      let maybe_llfunc = Llvm.operand instr (Llvm.num_operands instr - 1) in
+      let lltyp = Llvm.type_of maybe_llfunc in
+      assert (Poly.(Llvm.classify_type lltyp = Pointer)) ;
       let llfunc =
-        let maybe_llfunc =
-          Llvm.operand instr (Llvm.num_operands instr - 1)
-        in
         let llfunc_valuekind = Llvm.classify_value maybe_llfunc in
         match llfunc_valuekind with
         | Function | Instruction _ | InlineAsm | Argument -> maybe_llfunc
@@ -867,8 +867,6 @@ let xlate_instr :
             todo "operand kind in call instruction %a" pp_llvaluekind
               llfunc_valuekind ()
       in
-      let lltyp = Llvm.type_of llfunc in
-      assert (Poly.(Llvm.classify_type lltyp = Pointer)) ;
       let fname = Llvm.value_name llfunc in
       let skip msg =
         ( match Hash_set.strict_add ignored_callees fname with
@@ -947,7 +945,7 @@ let xlate_instr :
         (* general function call that may not throw *)
         | _ ->
             let func = xlate_func_name x llfunc in
-            let typ = xlate_type x (Llvm.type_of llfunc) in
+            let typ = xlate_type x lltyp in
             let lbl = name ^ ".ret" in
             let call =
               let args =
@@ -963,8 +961,13 @@ let xlate_instr :
                            function: %a"
                           Exp.pp func ()
                     | _ -> () ) ;
-                    Array.length
-                      (Llvm.param_types (Llvm.element_type lltyp))
+                    let llfty = Llvm.element_type lltyp in
+                    ( match Llvm.classify_type llfty with
+                    | Function -> ()
+                    | _ ->
+                        fail "called function not of function type: %a"
+                          pp_llvalue instr () ) ;
+                    Array.length (Llvm.param_types llfty)
                 in
                 List.rev_init num_args ~f:(fun i ->
                     xlate_value x (Llvm.operand instr i) )
@@ -993,6 +996,7 @@ let xlate_instr :
               warn "ignoring variable arguments to variadic function: %a"
                 Global.pp (xlate_global x llfunc) ()
           | _ -> () ) ;
+          assert (Poly.(Llvm.classify_type lltyp = Pointer)) ;
           Array.length (Llvm.param_types (Llvm.element_type lltyp)) )
       in
       let args =