diff --git a/sledge/src/control.ml b/sledge/src/control.ml index c7af95c56..54fc55766 100644 --- a/sledge/src/control.ml +++ b/sledge/src/control.ml @@ -281,8 +281,7 @@ module Make (Dom : Domain_sig.Dom) = struct if opts.function_summaries then Dom.dnf state else [state] in let domain_call = - Dom.call ~globals ~actuals ~areturn ~formals - ~locals:(Set.add_option freturn locals) + Dom.call ~globals ~actuals ~areturn ~formals ~freturn ~locals in List.fold ~init:Work.skip dnf_states ~f:(fun acc state -> match @@ -326,8 +325,7 @@ module Make (Dom : Domain_sig.Dom) = struct let exec_return ~opts stk pre_state (block : Llair.block) exp = let Llair.{name; formals; freturn; locals} = block.parent in - [%Trace.call fun {pf} -> - pf "from %a with pre_state %a" Reg.pp name.reg Dom.pp pre_state] + [%Trace.call fun {pf} -> pf "from: %a" Reg.pp name.reg] ; let summarize post_state = if opts.function_summaries then ( @@ -482,13 +480,14 @@ module Make (Dom : Domain_sig.Dom) = struct let entry_points = Config.find_list "entry-points" in List.find_map ~f:(Llair.Func.find pgm.functions) entry_points |> function - | Some {name= {reg}; locals; formals= []; entry} -> + | Some {name= {reg}; formals= []; freturn; locals; entry} -> Some (Work.init (fst (Dom.call ~summaries:opts.function_summaries ~globals:(used_globals opts reg) ~actuals:[] - ~areturn:None ~formals:[] ~locals (Dom.init pgm.globals))) + ~areturn:None ~formals:[] ~freturn ~locals + (Dom.init pgm.globals))) entry) | _ -> None diff --git a/sledge/src/domain/domain_sig.ml b/sledge/src/domain/domain_sig.ml index c7eb35f7a..7de4c162b 100644 --- a/sledge/src/domain/domain_sig.ml +++ b/sledge/src/domain/domain_sig.ml @@ -35,6 +35,7 @@ module type Dom = sig -> actuals:Exp.t list -> areturn:Reg.t option -> formals:Reg.t list + -> freturn:Reg.t option -> locals:Reg.Set.t -> t -> t * from_call diff --git a/sledge/src/domain/relation.ml b/sledge/src/domain/relation.ml index 961efd8ac..662230e9d 100644 --- a/sledge/src/domain/relation.ml +++ b/sledge/src/domain/relation.ml @@ -25,8 +25,8 @@ module Make (State_domain : State_domain_sig) = struct let embed b = (b, b) let pp fs (entry, curr) = - Format.fprintf fs "@[ entry: %a@;current:%a@]" State_domain.pp - entry State_domain.pp curr + Format.fprintf fs "@[entry: %a@ current: %a@]" State_domain.pp entry + State_domain.pp curr let report_fmt_thunk (_, curr) fs = State_domain.pp fs curr let init globals = embed (State_domain.init globals) @@ -68,7 +68,7 @@ module Make (State_domain : State_domain_sig) = struct let recursion_beyond_bound = State_domain.recursion_beyond_bound - let call ~summaries ~globals ~actuals ~areturn ~formals ~locals + let call ~summaries ~globals ~actuals ~areturn ~formals ~freturn ~locals (entry, current) = [%Trace.call fun {pf} -> pf @@ -80,7 +80,7 @@ module Make (State_domain : State_domain_sig) = struct ; let caller_current, state_from_call = State_domain.call ~summaries ~globals ~actuals ~areturn ~formals - ~locals current + ~freturn ~locals current in ( (caller_current, caller_current) , {state_from_call; caller_entry= entry} ) diff --git a/sledge/src/domain/unit.ml b/sledge/src/domain/unit.ml index f98d39f5c..9edfc9eaf 100644 --- a/sledge/src/domain/unit.ml +++ b/sledge/src/domain/unit.ml @@ -22,8 +22,8 @@ let exec_intrinsic ~skip_throw:_ _ _ _ _ : t option option = None type from_call = unit [@@deriving compare, equal, sexp] -let call ~summaries:_ ~globals:_ ~actuals:_ ~areturn:_ ~formals:_ ~locals:_ - _ = +let call ~summaries:_ ~globals:_ ~actuals:_ ~areturn:_ ~formals:_ ~freturn:_ + ~locals:_ _ = ((), ()) let recursion_beyond_bound = `skip diff --git a/sledge/src/domain/used_globals.ml b/sledge/src/domain/used_globals.ml index 8548ba7f6..5129257d9 100644 --- a/sledge/src/domain/used_globals.ml +++ b/sledge/src/domain/used_globals.ml @@ -63,8 +63,8 @@ let exec_intrinsic ~skip_throw:_ st _ intrinsic actuals = type from_call = t [@@deriving sexp_of] (* Set abstract state to bottom (i.e. empty set) at function entry *) -let call ~summaries:_ ~globals:_ ~actuals ~areturn:_ ~formals:_ ~locals:_ st - = +let call ~summaries:_ ~globals:_ ~actuals ~areturn:_ ~formals:_ ~freturn:_ + ~locals:_ st = (empty, List.fold actuals ~init:st ~f:(fun s a -> used_globals ~init:s a)) let resolve_callee lookup ptr st = diff --git a/sledge/src/symbheap/sh_domain.ml b/sledge/src/symbheap/sh_domain.ml index a54e01c59..62f8ecb74 100644 --- a/sledge/src/symbheap/sh_domain.ml +++ b/sledge/src/symbheap/sh_domain.ml @@ -113,7 +113,7 @@ type from_call = {areturn: Var.t option; subst: Var.Subst.t; frame: Sh.t} (** Express formula in terms of formals instead of actuals, and enter scope of locals: rename formals to fresh vars in formula and actuals, add equations between each formal and actual, and quantify fresh vars. *) -let call ~summaries ~globals ~actuals ~areturn ~formals ~locals q = +let call ~summaries ~globals ~actuals ~areturn ~formals ~freturn ~locals q = [%Trace.call fun {pf} -> pf "@[actuals: (@[%a@])@ formals: (@[%a@])@ locals: {@[%a@]}@ \ @@ -124,7 +124,7 @@ let call ~summaries ~globals ~actuals ~areturn ~formals ~locals q = let actuals = List.map ~f:Exp.term actuals in let areturn = Option.map ~f:Reg.var areturn in let formals = List.map ~f:Reg.var formals in - let locals = Reg.Set.vars locals in + let locals = Reg.Set.vars (Set.add_option freturn locals) in let q', freshen_locals = Sh.freshen q ~wrt:(Set.add_list formals locals) in