Section BOUNDS.
Variable f: function.
Definition record_reg (u: RegSet.t) (r: mreg) : RegSet.t :=
if is_callee_save r then RegSet.add r u else u.
Definition record_regs (u: RegSet.t) (rl: list mreg) : RegSet.t :=
fold_left record_reg rl u.
(** In the proof of the [Stacking] pass, we only need to bound the registers written by an instruction.  Therefore, we examine the result registers only, not the argument registers. *)
Definition record_regs_of_instr (u: RegSet.t) (i: instruction) : RegSet.t :=
match i with
| Lgetstack sl ofs ty r => record_reg u r
| Lsetstack r sl ofs ty => record_reg u r
| Lop op args res => record_reg u res
| Lload chunk addr args dst => record_reg u dst
| Lstore chunk addr args src => u
| Lcall sig ros => u
| Ltailcall sig ros => u
| Lbuiltin ef args res =>
record_regs (record_regs u (params_of_builtin_res res)) (destroyed_by_builtin ef)
| Llabel lbl => u
| Lgoto lbl => u
| Lcond cond args lbl => u
| Ljumptable arg tbl => u
| Lreturn => u
end.
Definition record_regs_of_function : RegSet.t :=
fold_left record_regs_of_instr f.(fn_code) RegSet.empty.
Fixpoint slots_of_locs (l: list loc) : list (slot * Z * typ) :=
match l with
| nil => nil
| S sl ofs ty :: l' => (sl, ofs, ty) :: slots_of_locs l'
| R r :: l' => slots_of_locs l'
end.
Definition slots_of_instr (i: instruction) : list (slot * Z * typ) :=
match i with
| Lgetstack sl ofs ty r => (sl, ofs, ty) :: nil
| Lsetstack r sl ofs ty => (sl, ofs, ty) :: nil
| Lbuiltin ef args res => slots_of_locs (params_of_builtin_args args)
| _ => nil
end.
Definition max_over_list {A: Type} (valu: A -> Z) (l: list A) : Z :=
List.fold_left (fun m l => Z.max m (valu l)) l 0.
Definition max_over_instrs (valu: instruction -> Z) : Z :=
max_over_list valu f.(fn_code).
Definition max_over_slots_of_instr (valu: slot * Z * typ -> Z) (i: instruction) : Z :=
max_over_list valu (slots_of_instr i).
Definition max_over_slots_of_funct (valu: slot * Z * typ -> Z) : Z :=
max_over_instrs (max_over_slots_of_instr valu).
Definition local_slot (s: slot * Z * typ) :=
match s with (Local, ofs, ty) => ofs + typesize ty | _ => 0 end.
Definition outgoing_slot (s: slot * Z * typ) :=
match s with (Outgoing, ofs, ty) => ofs + typesize ty | _ => 0 end.
Definition outgoing_space (i: instruction) :=
match i with Lcall sig _ => size_arguments sig | _ => 0 end.
(* Move elsewhere? *)
Remark fold_left_preserves:
forall (A B: Type) (f: A -> B -> A) (P: A -> Prop),
(forall a b, P a -> P (f a b)) ->
forall l a, P a -> P (fold_left f l a).
Remark fold_left_ensures:
forall (A B: Type) (f: A -> B -> A) (P: A -> Prop) b0,
(forall a b, P a -> P (f a b)) ->
(forall a, P (f a b0)) ->
forall l a, In b0 l -> P (fold_left f l a).
Definition only_callee_saves (u: RegSet.t) : Prop :=
forall r, RegSet.In r u -> is_callee_save r = true.
Program Definition function_bounds := {|
used_callee_save := RegSet.elements record_regs_of_function;
bound_local := max_over_slots_of_funct local_slot;
bound_outgoing := Z.max (max_over_instrs outgoing_space) (max_over_slots_of_funct outgoing_slot);
bound_stack_data := Z.max f.(fn_stacksize) 0
|}.
Next Obligation.
apply max_over_slots_of_funct_pos.
Qed.
Next Obligation.
apply Z.le_ge. eapply Z.le_trans. 2: apply Z.le_max_r.
apply Z.ge_le. apply max_over_slots_of_funct_pos.
Qed.
Next Obligation.
apply Z.le_ge. apply Z.le_max_r.
Qed.
Next Obligation.
generalize (RegSet.elements_3w record_regs_of_function).
generalize (RegSet.elements record_regs_of_function).
induction 1. constructor. constructor; auto.
red; intros; elim H. apply InA_alt. exists x; auto.
Qed.
Next Obligation.
apply record_regs_of_function_only. apply RegSet.elements_2.
apply InA_alt. exists r; auto.
Qed.
(** We now show the correctness of the inferred bounds. *)
Definition defined_by_instr (r': mreg) (i: instruction) :=
match i with
| Lgetstack sl ofs ty r => r' = r
| Lop op args res => r' = res
| Lload chunk addr args dst => r' = dst
| Lbuiltin ef args res => In r' (params_of_builtin_res res) \/ In r' (destroyed_by_builtin ef)
| _ => False
end.

Lemma size_arguments_bound:
forall sig ros,
In (Lcall sig ros) f.(fn_code) ->
size_arguments sig <= bound_outgoing function_bounds.