pghs975uc
/
infer_clone
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

[sledge] Factor out Frontend translation of "instruction" intrinsics

Browse Source 
Summary:
Move the translation of Calls to intrinsics that map to instructions
into a separat function.

No functional change.

Reviewed By: jvillard

Differential Revision: D25146169

fbshipit-source-id: 79c640344
master
Josh Berdine 4 years ago committed by Facebook GitHub Bot
parent 074f668c00
commit e9aff56bbc
1 changed files with 116 additions and 108 deletions
Show Stats Download Patch File Download Diff File

224
sledge/cli/frontend.ml
Unescape View File

@ -936,6 +936,61 @@ let ignored_callees = StringS.create 0
let xlate_size_of x llv = let xlate_size_of x llv =
Exp.integer Typ.siz (Z.of_int (size_of x (Llvm.type_of llv))) Exp.integer Typ.siz (Z.of_int (size_of x (Llvm.type_of llv)))
let xlate_intrinsic_inst emit_inst x llname instr loc =
let emit_inst ?prefix inst = Some (emit_inst ?prefix inst) in
match String.split_on_char llname ~by:'.' with
| ["__llair_choice"] ->
let reg = xlate_name x instr in
let msg = "__llair_choice" in
emit_inst (Inst.nondet ~reg:(Some reg) ~msg ~loc)
| ["__llair_alloc" (* void* __llair_alloc(unsigned size) *)] ->
let reg = xlate_name x instr in
let num_operand = Llvm.operand instr 0 in
let prefix, arg = xlate_value x num_operand in
let num =
convert_to_siz (xlate_type x (Llvm.type_of num_operand)) arg
in
let len = 1 in
emit_inst ~prefix (Inst.alloc ~reg ~num ~len ~loc)
| ["_Znwm" (* operator new(size_t num) *)]
|[ "_ZnwmSt11align_val_t"
(* operator new(unsigned long, std::align_val_t) *) ] ->
let reg = xlate_name x instr in
let prefix, num = xlate_value x (Llvm.operand instr 0) in
let len = size_of x (Llvm.type_of instr) in
emit_inst ~prefix (Inst.alloc ~reg ~num ~len ~loc)
| ["_ZdlPv" (* operator delete(void* ptr) *)]
|[ "_ZdlPvSt11align_val_t"
(* operator delete(void* ptr, std::align_val_t) *) ]
|[ "_ZdlPvmSt11align_val_t"
(* operator delete(void* ptr, unsigned long, std::align_val_t) *) ]
|["free" (* void free(void* ptr) *)] ->
let prefix, ptr = xlate_value x (Llvm.operand instr 0) in
emit_inst ~prefix (Inst.free ~ptr ~loc)
| "llvm" :: "memset" :: _ ->
let pre_0, dst = xlate_value x (Llvm.operand instr 0) in
let pre_1, byt = xlate_value x (Llvm.operand instr 1) in
let pre_2, len = xlate_value x (Llvm.operand instr 2) in
emit_inst
~prefix:(pre_0 @ pre_1 @ pre_2)
(Inst.memset ~dst ~byt ~len ~loc)
| "llvm" :: "memcpy" :: _ ->
let pre_0, dst = xlate_value x (Llvm.operand instr 0) in
let pre_1, src = xlate_value x (Llvm.operand instr 1) in
let pre_2, len = xlate_value x (Llvm.operand instr 2) in
emit_inst
~prefix:(pre_0 @ pre_1 @ pre_2)
(Inst.memcpy ~dst ~src ~len ~loc)
| "llvm" :: "memmove" :: _ ->
let pre_0, dst = xlate_value x (Llvm.operand instr 0) in
let pre_1, src = xlate_value x (Llvm.operand instr 1) in
let pre_2, len = xlate_value x (Llvm.operand instr 2) in
emit_inst
~prefix:(pre_0 @ pre_1 @ pre_2)
(Inst.memmov ~dst ~src ~len ~loc)
| ["abort"] | ["llvm"; "trap"] -> emit_inst (Inst.abort ~loc)
| _ -> None
let xlate_instr : let xlate_instr :
pop_thunk pop_thunk
-> x -> x
@ -1020,116 +1075,69 @@ let xlate_instr :
match xlate_intrinsic_exp fname with match xlate_intrinsic_exp fname with
| Some intrinsic -> inline_or_move (intrinsic x) | Some intrinsic -> inline_or_move (intrinsic x)
| None -> ( | None -> (
match String.split_on_char fname ~by:'.' with match xlate_intrinsic_inst emit_inst x fname instr loc with
| ["__llair_choice"] -> | Some code -> code
let reg = xlate_name x instr in | None -> (
let msg = "__llair_choice" in match String.split_on_char fname ~by:'.' with
emit_inst (Inst.nondet ~reg:(Some reg) ~msg ~loc) | ["__llair_throw"] ->
| ["__llair_throw"] -> let pre, exc = xlate_value x (Llvm.operand instr 0) in
let pre, exc = xlate_value x (Llvm.operand instr 0) in emit_term ~prefix:(pop loc @ pre) (Term.throw ~exc ~loc)
emit_term ~prefix:(pop loc @ pre) (Term.throw ~exc ~loc) (* dropped / handled elsewhere *)
| ["__llair_alloc" (* void* __llair_alloc(unsigned size) *)] -> | ["llvm"; "dbg"; ("declare" | "value")]
let reg = xlate_name x instr in |"llvm" :: ("lifetime" | "invariant") :: ("start" | "end") :: _
let num_operand = Llvm.operand instr 0 in ->
let prefix, arg = xlate_value x num_operand in nop ()
let num = (* unimplemented *)
convert_to_siz (xlate_type x (Llvm.type_of num_operand)) arg | ["llvm"; ("stacksave" | "stackrestore")] ->
in skip "dynamic stack deallocation"
let len = 1 in | "llvm" :: "coro" :: _ ->
emit_inst ~prefix (Inst.alloc ~reg ~num ~len ~loc) todo "coroutines:@ %a" pp_llvalue instr ()
| ["_Znwm" (* operator new(size_t num) *)] | "llvm" :: "experimental" :: "gc" :: "statepoint" :: _ ->
|[ "_ZnwmSt11align_val_t" todo "statepoints:@ %a" pp_llvalue instr ()
(* operator new(unsigned long, std::align_val_t) *) ] -> | ["llvm"; ("va_start" | "va_copy" | "va_end")] ->
let reg = xlate_name x instr in skip "variadic function intrinsic"
let prefix, num = xlate_value x (Llvm.operand instr 0) in | "llvm" :: _ -> skip "intrinsic"
let len = size_of x (Llvm.type_of instr) in | _ when Poly.equal (Llvm.classify_value llfunc) InlineAsm ->
emit_inst ~prefix (Inst.alloc ~reg ~num ~len ~loc) skip "inline asm"
| ["_ZdlPv" (* operator delete(void* ptr) *)] (* general function call that may not throw *)
|[ "_ZdlPvSt11align_val_t" | _ ->
(* operator delete(void* ptr, std::align_val_t) *) ] let pre0, callee = xlate_value x llfunc in
|[ "_ZdlPvmSt11align_val_t" let typ = xlate_type x lltyp in
(* operator delete(void* ptr, unsigned long, std::align_val_t) *) let lbl = name ^ ".ret" in
] let pre, call =
|["free" (* void free(void* ptr) *)] -> let pre, actuals =
let prefix, ptr = xlate_value x (Llvm.operand instr 0) in let num_actuals =
emit_inst ~prefix (Inst.free ~ptr ~loc) if not (Llvm.is_var_arg (Llvm.element_type lltyp)) then
| "llvm" :: "memset" :: _ -> Llvm.num_arg_operands instr
let pre_0, dst = xlate_value x (Llvm.operand instr 0) in else
let pre_1, byt = xlate_value x (Llvm.operand instr 1) in let fname = Llvm.value_name llfunc in
let pre_2, len = xlate_value x (Llvm.operand instr 2) in if
emit_inst StringS.add ignored_callees fname
~prefix:(pre_0 @ pre_1 @ pre_2) && not (Llvm.is_declaration llfunc)
(Inst.memset ~dst ~byt ~len ~loc) then
| "llvm" :: "memcpy" :: _ -> warn
let pre_0, dst = xlate_value x (Llvm.operand instr 0) in "ignoring variable arguments to variadic \
let pre_1, src = xlate_value x (Llvm.operand instr 1) in function: %a"
let pre_2, len = xlate_value x (Llvm.operand instr 2) in Exp.pp callee () ;
emit_inst let llfty = Llvm.element_type lltyp in
~prefix:(pre_0 @ pre_1 @ pre_2) ( match Llvm.classify_type llfty with
(Inst.memcpy ~dst ~src ~len ~loc) | Function -> ()
| "llvm" :: "memmove" :: _ -> | _ ->
let pre_0, dst = xlate_value x (Llvm.operand instr 0) in fail "called function not of function type: %a"
let pre_1, src = xlate_value x (Llvm.operand instr 1) in pp_llvalue instr () ) ;
let pre_2, len = xlate_value x (Llvm.operand instr 2) in Array.length (Llvm.param_types llfty)
emit_inst in
~prefix:(pre_0 @ pre_1 @ pre_2) xlate_values x num_actuals (Llvm.operand instr)
(Inst.memmov ~dst ~src ~len ~loc)
| ["abort"] | ["llvm"; "trap"] -> emit_inst (Inst.abort ~loc)
(* dropped / handled elsewhere *)
| ["llvm"; "dbg"; ("declare" | "value")]
|"llvm" :: ("lifetime" | "invariant") :: ("start" | "end") :: _ ->
nop ()
(* unimplemented *)
| ["llvm"; ("stacksave" | "stackrestore")] ->
skip "dynamic stack deallocation"
| "llvm" :: "coro" :: _ ->
todo "coroutines:@ %a" pp_llvalue instr ()
| "llvm" :: "experimental" :: "gc" :: "statepoint" :: _ ->
todo "statepoints:@ %a" pp_llvalue instr ()
| ["llvm"; ("va_start" | "va_copy" | "va_end")] ->
skip "variadic function intrinsic"
| "llvm" :: _ -> skip "intrinsic"
| _ when Poly.equal (Llvm.classify_value llfunc) InlineAsm ->
skip "inline asm"
(* general function call that may not throw *)
| _ ->
let pre0, callee = xlate_value x llfunc in
let typ = xlate_type x lltyp in
let lbl = name ^ ".ret" in
let pre, call =
let pre, actuals =
let num_actuals =
if not (Llvm.is_var_arg (Llvm.element_type lltyp)) then
Llvm.num_arg_operands instr
else
let fname = Llvm.value_name llfunc in
if
StringS.add ignored_callees fname
&& not (Llvm.is_declaration llfunc)
then
warn
"ignoring variable arguments to variadic function: \
%a"
Exp.pp callee () ;
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 in
xlate_values x num_actuals (Llvm.operand instr) let areturn = xlate_name_opt x instr in
let return = Jump.mk lbl in
( pre
, Term.call ~callee ~typ ~actuals ~areturn ~return
~throw:None ~loc )
in in
let areturn = xlate_name_opt x instr in continue (fun (insts, term) ->
let return = Jump.mk lbl in let cmnd = IArray.of_list insts in
( pre (pre0 @ pre, call, [Block.mk ~lbl ~cmnd ~term]) ) ) ) )
, Term.call ~callee ~typ ~actuals ~areturn ~return ~throw:None
~loc )
in
continue (fun (insts, term) ->
let cmnd = IArray.of_list insts in
(pre0 @ pre, call, [Block.mk ~lbl ~cmnd ~term]) ) ) )
| Invoke -> ( | Invoke -> (
let llfunc = Llvm.operand instr (Llvm.num_operands instr - 3) in let llfunc = Llvm.operand instr (Llvm.num_operands instr - 3) in
let lltyp = Llvm.type_of llfunc in let lltyp = Llvm.type_of llfunc in

Write Preview
Loading…
Cancel
Save