(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)
(** Computation of resource bounds for Linear code. *)
Require Intv.
Module RegOrd := OrderedIndexed (IndexedMreg).
Module RegSet := FSetAVL.Make (RegOrd).
(** * Resource bounds for a function *)
(** The [bounds] record capture how many local and outgoing stack slots and callee-save registers are used by a function. *)
(** We demand that all bounds are positive or null. These properties are used later to reason about the layout of the activation record. *)
Record bounds : Type := mkbounds {
used_callee_save: list mreg;
bound_local: Z;
bound_outgoing: Z;
bound_stack_data: Z;
bound_local_pos: bound_local >= 0;
bound_outgoing_pos: bound_outgoing >= 0;
bound_stack_data_pos: bound_stack_data >= 0;
used_callee_save_norepet: list_norepet used_callee_save;
used_callee_save_prop: forall r, In r used_callee_save -> is_callee_save r = true
}.
(** The following predicates define the correctness of a set of bounds for the code of a function. *)
Section WITHIN_BOUNDS.
Variable b: bounds.
Definition mreg_within_bounds (r: mreg) :=
is_callee_save r = true -> In r (used_callee_save b).
Definition slot_within_bounds (sl: slot) (ofs: Z) (ty: typ) :=
match sl with
| Local => ofs + typesize ty <= bound_local b
| Outgoing => ofs + typesize ty <= bound_outgoing b
| Incoming => True
end.
Definition instr_within_bounds (i: instruction) :=
match i with
| Lgetstack sl ofs ty r => slot_within_bounds sl ofs ty /\ mreg_within_bounds r
| Lsetstack r sl ofs ty => slot_within_bounds sl ofs ty
| Lop op args res => mreg_within_bounds res
| Lload chunk addr args dst => mreg_within_bounds dst
| Lcall sig ros => size_arguments sig <= bound_outgoing b
| Lbuiltin ef args res =>
(forall r, In r (params_of_builtin_res res) \/ In r (destroyed_by_builtin ef) -> mreg_within_bounds r)
/\ (forall sl ofs ty, In (S sl ofs ty) (params_of_builtin_args args) -> slot_within_bounds sl ofs ty)
| _ => True
end.
End WITHIN_BOUNDS.
Definition function_within_bounds (f: function) (b: bounds) : Prop :=
forall instr, In instr f.(fn_code) -> instr_within_bounds b instr.
(** * Inference of resource bounds for a function *)
(** The resource bounds for a function are computed by a linear scan of its instructions. *)
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.

(* Specifications: *)
Lemma max_over_list_pos:
forall (A: Type) (valu: A -> Z) (l: list A),
max_over_list valu l >= 0.
Lemma max_over_slots_of_funct_pos:
forall (valu: slot * Z * typ -> Z), max_over_slots_of_funct valu >= 0.