(** ** Semantic invariant *)
Section SOUNDNESS.
Variable prog: program.
Variable ge: genv.
Let rm := romem_for prog.
Inductive sound_stack: block_classification -> list stackframe -> mem -> block -> Prop :=
| sound_stack_nil: forall bc m bound,
sound_stack bc nil m bound
| sound_stack_public_call:
forall (bc: block_classification) res f sp pc e stk m bound bc' bound' ae
(STK: sound_stack bc' stk m sp)
(INCR: Ple bound' bound)
(BELOW: bc_below bc' bound')
(SP: bc sp = BCother)
(SP': bc' sp = BCstack)
(SAME: forall b, Plt b bound' -> b <> sp -> bc b = bc' b)
(GE: genv_match bc' ge)
(AN: VA.ge (analyze rm f)!!pc (VA.State (AE.set res Vtop ae) mafter_public_call))
(EM: ematch bc' e ae),
sound_stack bc (Stackframe res f (Vptr sp Ptrofs.zero) pc e :: stk) m bound
| sound_stack_private_call:
forall (bc: block_classification) res f sp pc e stk m bound bc' bound' ae am
(STK: sound_stack bc' stk m sp)
(INCR: Ple bound' bound)
(BELOW: bc_below bc' bound')
(SP: bc sp = BCinvalid)
(SP': bc' sp = BCstack)
(SAME: forall b, Plt b bound' -> b <> sp -> bc b = bc' b)
(GE: genv_match bc' ge)
(AN: VA.ge (analyze rm f)!!pc (VA.State (AE.set res (Ifptr Nonstack) ae) (mafter_private_call am)))
(EM: ematch bc' e ae)
(CONTENTS: bmatch bc' m sp am.(am_stack)),
sound_stack bc (Stackframe res f (Vptr sp Ptrofs.zero) pc e :: stk) m bound.
Inductive sound_state_base: state -> Prop :=
| sound_regular_state:
forall s f sp pc e m ae am bc
(STK: sound_stack bc s m sp)
(AN: (analyze rm f)!!pc = VA.State ae am)
(EM: ematch bc e ae)
(RO: romatch bc m rm)
(MM: mmatch bc m am)
(GE: genv_match bc ge)
(SP: bc sp = BCstack),
sound_state_base (State s f (Vptr sp Ptrofs.zero) pc e m)
| sound_call_state:
forall s fd args m bc
(STK: sound_stack bc s m (Mem.nextblock m))
(ARGS: forall v, In v args -> vmatch bc v Vtop)
(RO: romatch bc m rm)
(MM: mmatch bc m mtop)
(GE: genv_match bc ge)
(NOSTK: bc_nostack bc),
sound_state_base (Callstate s fd args m)
| sound_return_state:
forall s v m bc
(STK: sound_stack bc s m (Mem.nextblock m))
(RES: vmatch bc v Vtop)
(RO: romatch bc m rm)
(MM: mmatch bc m mtop)
(GE: genv_match bc ge)
(NOSTK: bc_nostack bc),
sound_state_base (Returnstate s v m).
(** Properties of the [sound_stack] invariant on call stacks. *)

(* Specifications: *)
Lemma sound_stack_ext:
forall m' bc stk m bound,
sound_stack bc stk m bound ->
(forall b ofs n bytes,
Plt b bound -> bc b = BCinvalid -> n >= 0 ->
Mem.loadbytes m' b ofs n = Some bytes ->
Mem.loadbytes m b ofs n = Some bytes) ->
sound_stack bc stk m' bound.
Lemma sound_stack_inv:
forall m' bc stk m bound,
sound_stack bc stk m bound ->
(forall b ofs n, Plt b bound -> bc b = BCinvalid -> n >= 0 -> Mem.loadbytes m' b ofs n = Mem.loadbytes m b ofs n) ->
sound_stack bc stk m' bound.
Lemma sound_stack_storev:
forall chunk m addr v m' bc aaddr stk bound,
Mem.storev chunk m addr v = Some m' ->
vmatch bc addr aaddr ->
sound_stack bc stk m bound ->
sound_stack bc stk m' bound.
Lemma sound_stack_storebytes:
forall m b ofs bytes m' bc aaddr stk bound,
Mem.storebytes m b (Ptrofs.unsigned ofs) bytes = Some m' ->
vmatch bc (Vptr b ofs) aaddr ->
sound_stack bc stk m bound ->
sound_stack bc stk m' bound.
Lemma sound_stack_free:
forall m b lo hi m' bc stk bound,
Mem.free m b lo hi = Some m' ->
sound_stack bc stk m bound ->
sound_stack bc stk m' bound.
Lemma sound_stack_new_bound:
forall bc stk m bound bound',
sound_stack bc stk m bound ->
Ple bound bound' ->
sound_stack bc stk m bound'.
Lemma sound_stack_exten:
forall bc stk m bound (bc1: block_classification),
sound_stack bc stk m bound ->
(forall b, Plt b bound -> bc1 b = bc b) ->
sound_stack bc1 stk m bound.