(* Require Import VST.concurrency.common.core_semantics. Require Import VST.concurrency.common.bounded_maps. Require Import VST.concurrency.common.threadPool. Require Import VST.concurrency.common.permissions. Require Import VST.concurrency.common.HybridMachineSig. Require Import VST.concurrency.common.ClightSemanticsForMachines. Require Import VST.concurrency.common.ClightMachine. Require Import VST.concurrency.common.dry_machine_lemmas. Require Import VST.concurrency.juicy.semax_simlemmas. Require Import VST.concurrency.juicy.semax_to_juicy_machine. Require Import VST.concurrency.juicy.mem_wd2. Require Import VST.veric.Clight_sim. *)
Set Bullet Behavior "Strict Subproofs".
Section GE.
Variable ge: Clight.genv.
Section CTL_OK.
Variable nextb : block.
Definition block_ok (b: block) := Plt b nextb.
Definition val_ok (v: val) : Prop :=
match v with
| Vptr b _ => block_ok b
| _ => True
end.
Definition venv_ok (ve: Clight.env) :=
forall i bt, PTree.get i ve = Some bt -> block_ok (fst bt).
Definition tenv_ok (te: Clight.temp_env) :=
forall i (v: val), PTree.get i te = Some v -> val_ok v.
Definition cont'_ok (k: Clight_new.cont') :=
match k with
| Clight_new.Kcall _ _ ve te => venv_ok ve /\ tenv_ok te
| _ => True
end.
Definition cont_ok (k: Clight_new.cont) := Forall cont'_ok k.
Definition corestate_ok (q: Clight_new.corestate) : Prop :=
match q with
| Clight_new.State ve te k => venv_ok ve /\ tenv_ok te /\ cont_ok k
| Clight_new.ExtCall f vl _ ve te k => Forall val_ok vl /\ venv_ok ve /\ tenv_ok te /\ cont_ok k
end.
End CTL_OK.
Section ALLOC_OK.
Variable nextb: positive.
Variable nextb': positive.
Variable LESS:  (nextb <= nextb')%positive.

(* Specifications: *)
Lemma alloc_block_ok: forall b, block_ok nextb b -> block_ok nextb' b.
Lemma alloc_val_ok: forall v, val_ok nextb v -> val_ok nextb' v.
Lemma alloc_venv_ok: forall ve, venv_ok nextb ve -> venv_ok nextb' ve.
Lemma alloc_tenv_ok: forall te, tenv_ok nextb te -> tenv_ok nextb' te.
Lemma alloc_cont'_ok: forall k, cont'_ok nextb k -> cont'_ok nextb' k.
Lemma alloc_cont_ok: forall k, cont_ok nextb k -> cont_ok nextb' k.
Lemma alloc_corestate_ok: forall q, corestate_ok nextb q -> corestate_ok nextb' q.
End ALLOC_OK.
Lemma set_tenv_ok:
forall nextb i (v: val) te, val_ok nextb v -> tenv_ok nextb te ->
tenv_ok nextb (PTree.set i v te).
Lemma set_venv_ok:
forall nextb i v ve, block_ok nextb (fst v) -> venv_ok nextb ve ->
venv_ok nextb (PTree.set i v ve).
Lemma sem_add_ptr_int_ok:
forall nextb ty si v1 v2 v,
val_ok nextb v1 ->
val_ok nextb v2 ->
Cop.sem_add_ptr_int (genv_cenv ge) ty si v1 v2 = Some v ->
val_ok nextb v.
Lemma sem_add_ptr_long_ok:
forall nextb ty v1 v2 v,
val_ok nextb v1 ->
val_ok nextb v2 ->
Cop.sem_add_ptr_long (genv_cenv ge) ty v1 v2 = Some v ->
val_ok nextb v.
Lemma sem_cast_ok:
forall nextb v1 t1 t2 m v,
val_ok nextb v1 ->
Cop.sem_cast v1 t1 t2 m = Some v ->
val_ok nextb v.
Lemma val_of_bool_ok:
forall nextb b, val_ok nextb (Val.of_bool b).
Lemma sem_cmp_ok:
forall nextb op v1 t1 v2 t2 m v,
Cop.sem_cmp op v1 t1 v2 t2 m = Some v ->
val_ok nextb v1 -> val_ok nextb v2 -> val_ok nextb v.
Lemma binary_operation_ok:
forall nextb (op : Cop.binary_operation) (v1 : val) (t1 : type)
(v2 : val) (t2 : type) (m : mem) (v : val),
val_ok nextb v1 ->
val_ok nextb v2 ->
Cop.sem_binary_operation (Clight.genv_cenv ge) op v1 t1 v2 t2 m = Some v ->
val_ok nextb v.
Lemma loadbytes_proj_ok:
forall m loc ofs sz bl ch q,
block_ok (Mem.nextblock m) loc ->
mem_wd2 m ->
Mem.loadbytes m loc ofs sz = Some bl ->
val_ok (Mem.nextblock m) (Val.load_result ch (proj_value q bl)).
Lemma deref_loc_ok:
forall m loc ofs t1 v,
mem_wd2 m ->
block_ok (Mem.nextblock m) loc ->
deref_loc t1 m loc ofs v ->
val_ok (Mem.nextblock m) v.
Lemma eval_expr_ok:
forall (m : mem) (ve : Clight.env) (te : Clight.temp_env)
(a : Clight.expr) (v : val),
@Smallstep.globals_not_fresh Clight.fundef type (Clight.genv_genv ge) m ->
mem_wd2 m ->
venv_ok (Mem.nextblock m) ve ->
tenv_ok (Mem.nextblock m) te ->
eval_expr ge ve te m a v ->
val_ok (Mem.nextblock m) v
with eval_lvalue_ok:
forall (m : mem) (ve : Clight.env) (te : Clight.temp_env)
(a : Clight.expr) (v : block) ofs,
@Smallstep.globals_not_fresh Clight.fundef type (Clight.genv_genv ge) m ->
mem_wd2 m ->
venv_ok (Mem.nextblock m) ve ->
tenv_ok (Mem.nextblock m) te ->
eval_lvalue ge ve te m a v ofs ->
block_ok (Mem.nextblock m) v.
Lemma eval_exprlist_ok:
forall (m : mem) (ve : Clight.env) (te : Clight.temp_env)
(al : list Clight.expr) tl (vl : list val),
@Smallstep.globals_not_fresh Clight.fundef type (Clight.genv_genv ge) m ->
mem_wd2 m ->
venv_ok (Mem.nextblock m) ve ->
tenv_ok (Mem.nextblock m) te ->
eval_exprlist ge ve te m al tl vl ->
Forall (val_ok (Mem.nextblock m)) vl.
Lemma find_label_ok:
forall nextb lbl s (al : list cont') (k' : cont),
cont_ok nextb al ->
find_label lbl s al = Some k' ->
cont_ok nextb k'
with find_label_ls_ok:
forall nextb lbl s (al : list cont') (k' : cont),
cont_ok nextb al ->
find_label_ls lbl s al = Some k' ->
cont_ok nextb k'.
Lemma mem_ok_goto:
forall (k : cont) (lbl : Clight.label)
(s' : Clight.statement) (nextb : block),
cont_ok nextb k ->
forall (s : Clight.statement) (k' : cont),
find_label lbl s
(Kseq s' :: Clight_new.call_cont k) =
Some k' -> cont_ok nextb k'.
Lemma loadbytes_storebytes_wd2:
forall m b' z' sz b z bytes m',
mem_wd2 m ->
Mem.loadbytes m b' z' sz = Some bytes ->
Mem.storebytes m b z bytes = Some m' -> mem_wd2 m'.
Lemma mem_wd_freelist:
forall m bl m', Mem.free_list m bl = Some m' -> mem_wd2 m -> mem_wd2 m'.
Lemma alloc_variables_ok:
forall ve m vl ve' m',
mem_wd2 m ->
venv_ok (Mem.nextblock m) ve ->
alloc_variables ge ve m vl ve' m' ->
venv_ok (Mem.nextblock m') ve' /\ mem_wd2 m' /\ (Mem.nextblock m <= Mem.nextblock m')%positive.
Lemma bind_parameter_temps_ok:
forall m fl vl te te',
tenv_ok (Mem.nextblock m) te ->
Forall (val_ok (Mem.nextblock m))vl ->
bind_parameter_temps fl vl te = Some te' ->
tenv_ok (Mem.nextblock m) te'.
Lemma call_cont_ok_lemma:
forall f optid k m ve' te' k',
call_cont k = Kcall optid f ve' te' :: k' ->
Forall (cont'_ok (Mem.nextblock m)) k ->
venv_ok (Mem.nextblock m) ve' /\
tenv_ok (Mem.nextblock m) te' /\ cont_ok (Mem.nextblock m) k'.
Lemma cl_step_ok:
forall c m c' m',
Clight_new.cl_step ge c m c' m' ->
Smallstep.globals_not_fresh (Clight.genv_genv ge) m /\
mem_wd2 m /\ corestate_ok (Mem.nextblock m) c ->
mem_wd2 m' /\
corestate_ok (Mem.nextblock m') c' /\
(Mem.nextblock m <= Mem.nextblock m')%positive.