diff --git a/sledge/src/control.ml b/sledge/src/control.ml index 99f9e64fb..c7af95c56 100644 --- a/sledge/src/control.ml +++ b/sledge/src/control.ml @@ -271,7 +271,7 @@ module Make (Dom : Domain_sig.Dom) = struct let summary_table = Hashtbl.create (module Reg) let exec_call opts stk state block call globals = - let Llair.{callee; args= actuals; areturn; return; recursive} = call in + let Llair.{callee; actuals; areturn; return; recursive} = call in let Llair.{name; formals; freturn; locals; entry} = callee in [%Trace.call fun {pf} -> pf "%a from %a with state %a" Reg.pp name.reg Reg.pp @@ -430,7 +430,7 @@ module Make (Dom : Domain_sig.Dom) = struct with | Some state -> exec_jump stk state block jump |> Work.seq x | None -> x ) - | Call ({callee; args; areturn; return} as call) -> ( + | Call ({callee; actuals; areturn; return} as call) -> ( let lookup name = Option.to_list (Llair.Func.find pgm.functions name) in @@ -441,7 +441,7 @@ module Make (Dom : Domain_sig.Dom) = struct List.fold callees ~init:Work.skip ~f:(fun x callee -> ( match Dom.exec_intrinsic ~skip_throw:opts.skip_throw state - areturn callee.name.reg args + areturn callee.name.reg actuals with | Some None -> Report.invalid_access_term diff --git a/sledge/src/llair/frontend.ml b/sledge/src/llair/frontend.ml index ef6c60258..a7b79ca5d 100644 --- a/sledge/src/llair/frontend.ml +++ b/sledge/src/llair/frontend.ml @@ -971,8 +971,8 @@ let xlate_instr : let typ = xlate_type x lltyp in let lbl = name ^ ".ret" in let call = - let args = - let num_args = + let actuals = + let num_actuals = if not (Llvm.is_var_arg (Llvm.element_type lltyp)) then Llvm.num_arg_operands instr else @@ -992,13 +992,13 @@ let xlate_instr : pp_llvalue instr () ) ; Array.length (Llvm.param_types llfty) in - List.rev_init num_args ~f:(fun i -> + List.rev_init num_actuals ~f:(fun i -> xlate_value x (Llvm.operand instr i) ) in let areturn = xlate_name_opt x instr in let return = Llair.Jump.mk lbl in - Llair.Term.call ~func ~typ ~args ~areturn ~return ~throw:None - ~loc + Llair.Term.call ~func ~typ ~actuals ~areturn ~return + ~throw:None ~loc in continue (fun (insts, term) -> let cmnd = Vector.of_list insts in @@ -1010,7 +1010,7 @@ let xlate_instr : let fname = Llvm.value_name llfunc in let return_blk = Llvm.get_normal_dest instr in let unwind_blk = Llvm.get_unwind_dest instr in - let num_args = + let num_actuals = if not (Llvm.is_var_arg (Llvm.element_type lltyp)) then Llvm.num_arg_operands instr else ( @@ -1022,11 +1022,6 @@ let xlate_instr : assert (Poly.(Llvm.classify_type lltyp = Pointer)) ; Array.length (Llvm.param_types (Llvm.element_type lltyp)) ) in - let args = - List.rev_init num_args ~f:(fun i -> - xlate_value x (Llvm.operand instr i) ) - in - let areturn = xlate_name_opt x instr in (* intrinsics *) match String.split fname ~on:'.' with | _ when Option.is_some (xlate_intrinsic_exp fname) -> @@ -1040,7 +1035,7 @@ let xlate_instr : | ["_Znwm" (* operator new(size_t num) *)] |[ "_ZnwmSt11align_val_t" (* operator new(unsigned long num, std::align_val_t) *) ] - when num_args > 0 -> + when num_actuals > 0 -> let reg = xlate_name x instr in let num = xlate_value x (Llvm.operand instr 0) in let len = Exp.size_of (Exp.reg reg) in @@ -1056,11 +1051,17 @@ let xlate_instr : | _ -> let func = xlate_func_name x llfunc in let typ = xlate_type x (Llvm.type_of llfunc) in + let actuals = + List.rev_init num_actuals ~f:(fun i -> + xlate_value x (Llvm.operand instr i) ) + in + let areturn = xlate_name_opt x instr in let return, blocks = xlate_jump x instr return_blk loc [] in let throw, blocks = xlate_jump x instr unwind_blk loc blocks in let throw = Some throw in emit_term - (Llair.Term.call ~func ~typ ~args ~areturn ~return ~throw ~loc) + (Llair.Term.call ~func ~typ ~actuals ~areturn ~return ~throw + ~loc) ~blocks ) | Ret -> let exp = @@ -1146,11 +1147,11 @@ let xlate_instr : let ti = Exp.reg ti in let typeid = xlate_llvm_eh_typeid_for x tip ti in let lbl = name ^ ".unwind" in - let param = xlate_name x instr in + let reg = xlate_name x instr in let jump_unwind i sel rev_blocks = - let arg = Exp.record exc_typ (Vector.of_array [|exc; sel|]) in + let exp = Exp.record exc_typ (Vector.of_array [|exc; sel|]) in let mov = - Llair.Inst.move ~reg_exps:(Vector.of_array [|(param, arg)|]) ~loc + Llair.Inst.move ~reg_exps:(Vector.of_array [|(reg, exp)|]) ~loc in let lbl = lbl ^ "." ^ Int.to_string i in let blk = diff --git a/sledge/src/llair/llair.ml b/sledge/src/llair/llair.ml index a95e1bd49..c66122255 100644 --- a/sledge/src/llair/llair.ml +++ b/sledge/src/llair/llair.ml @@ -30,7 +30,7 @@ type jump = {mutable dst: block; mutable retreating: bool} and 'a call = { callee: 'a ; typ: Typ.t - ; args: Exp.t list + ; actuals: Exp.t list ; areturn: Reg.t option ; return: jump ; throw: jump option @@ -81,12 +81,12 @@ let sexp_of_term = function {key: Exp.t; tbl: (Exp.t * jump) vector; els: jump; loc: Loc.t}] | Iswitch {ptr; tbl; loc} -> sexp_ctor "Iswitch" [%sexp {ptr: Exp.t; tbl: jump vector; loc: Loc.t}] - | Call {callee; typ; args; areturn; return; throw; recursive; loc} -> + | Call {callee; typ; actuals; areturn; return; throw; recursive; loc} -> sexp_ctor "Call" [%sexp { callee: Exp.t ; typ: Typ.t - ; args: Exp.t list + ; actuals: Exp.t list ; areturn: Reg.t option ; return: jump ; throw: jump option @@ -158,8 +158,9 @@ let pp_inst fs inst = reg msg Loc.pp loc | Abort {loc} -> pf "@[<2>abort;@]\t%a" Loc.pp loc -let pp_args pp_arg fs args = - Format.fprintf fs "@ (@[%a@])" (List.pp ",@ " pp_arg) (List.rev args) +let pp_actuals pp_actual fs actuals = + Format.fprintf fs "@ (@[%a@])" (List.pp ",@ " pp_actual) + (List.rev actuals) let pp_formal fs reg = Reg.pp fs reg @@ -188,12 +189,12 @@ let pp_term fs term = (Vector.pp "@ " (fun fs jmp -> Format.fprintf fs "%s: %a" jmp.dst.lbl pp_goto jmp )) tbl Loc.pp loc - | Call {callee; args; areturn; return; throw; recursive; loc; _} -> + | Call {callee; actuals; areturn; return; throw; recursive; loc; _} -> pf "@[<2>@[<7>%acall @[<2>%s%a%a@]@]@ @[returnto %a%a;@]@]\t%a" (Option.pp "%a := " Reg.pp) areturn (if recursive then "↑" else "") - Exp.pp callee (pp_args Exp.pp) args pp_jump return + Exp.pp callee (pp_actuals Exp.pp) actuals pp_jump return (Option.pp "@ throwto %a" pp_jump) throw Loc.pp loc | Return {exp; loc} -> @@ -309,10 +310,10 @@ module Term = struct @@ fun () -> match term with | Switch _ | Iswitch _ -> assert true - | Call {typ; args= actls; areturn; _} -> ( + | Call {typ; actuals; areturn; _} -> ( match typ with - | Pointer {elt= Function {args= frmls; return= retn_typ; _}} -> - assert (Vector.length frmls = List.length actls) ; + | Pointer {elt= Function {args; return= retn_typ; _}} -> + assert (Vector.length args = List.length actuals) ; assert (Option.is_some retn_typ || Option.is_none areturn) | _ -> assert false ) | Return {exp; _} -> ( @@ -336,11 +337,11 @@ module Term = struct let iswitch ~ptr ~tbl ~loc = Iswitch {ptr; tbl; loc} |> check invariant - let call ~func ~typ ~args ~areturn ~return ~throw ~loc = + let call ~func ~typ ~actuals ~areturn ~return ~throw ~loc = Call { callee= func ; typ - ; args + ; actuals ; areturn ; return ; throw @@ -408,7 +409,7 @@ module Func = struct | Pointer {elt= Function {return; _}} -> return | _ -> None ) (Option.pp " %a := " Reg.pp) - freturn Global.pp name (pp_args pp_formal) formals + freturn Global.pp name (pp_actuals pp_formal) formals (fun fs -> if is_undefined func then Format.fprintf fs " #%i@]" sort_index else diff --git a/sledge/src/llair/llair.mli b/sledge/src/llair/llair.mli index 176422a5a..998318fef 100644 --- a/sledge/src/llair/llair.mli +++ b/sledge/src/llair/llair.mli @@ -48,7 +48,7 @@ type jump = {mutable dst: block; mutable retreating: bool} and 'a call = { callee: 'a ; typ: Typ.t (** Type of the callee. *) - ; args: Exp.t list (** Stack of arguments, first-arg-last. *) + ; actuals: Exp.t list (** Stack of arguments, first-arg-last. *) ; areturn: Reg.t option (** Register to receive return value. *) ; return: jump (** Return destination. *) ; throw: jump option (** Handler destination. *) @@ -153,7 +153,7 @@ module Term : sig val call : func:Exp.t -> typ:Typ.t - -> args:Exp.t list + -> actuals:Exp.t list -> areturn:Reg.t option -> return:jump -> throw:jump option