(* Clight SEmantics for Machines*)
(* We define event semantics for - Clight_new: the core semantics defined by VST - Clightcore: the core semantics derived from CompCert's Clight *)
(*IM using proof irrelevance!*)
(* The concurrent machinery*)
Arguments sizeof {env} !t / .
(*Semantics*)
Set Bullet Behavior "Strict Subproofs".
Inductive alloc_variablesT (g: genv): PTree.t (block * type) -> mem -> list (ident * type) ->
PTree.t (block * type) -> mem -> (list mem_event) -> Prop :=
alloc_variablesT_nil : forall e m, alloc_variablesT g e m nil e m nil
| alloc_variablesT_cons :
forall e m id ty vars m1 b1 m2 e2 T,
Mem.alloc m 0 (@sizeof g ty) = (m1, b1) ->
alloc_variablesT g (PTree.set id (b1, ty) e) m1 vars e2 m2 T ->
alloc_variablesT g e m ((id, ty) :: vars) e2 m2 (Alloc b1 0 (@sizeof g ty) :: T).
(*exists e',*) alloc_variablesT g e mm l e' mm' T).  Section EXPR_T. (** Extends Clight.eval_expr etc with event traces. *)
Variable e: env.
Variable le: temp_env.
Variable m: mem.
Inductive eval_exprT: expr -> val -> list mem_event-> Prop :=
| evalT_Econst_int:   forall i ty,
eval_exprT (Econst_int i ty) (Vint i) nil
| evalT_Econst_float:   forall f ty,
eval_exprT (Econst_float f ty) (Vfloat f) nil
| evalT_Econst_single:   forall f ty,
eval_exprT (Econst_single f ty) (Vsingle f) nil
| evalT_Econst_long:   forall i ty,
eval_exprT (Econst_long i ty) (Vlong i) nil
| evalT_Etempvar:  forall id ty v,
le!id = Some v ->
eval_exprT (Etempvar id ty) v nil
| evalT_Eaddrof: forall a ty loc ofs T,
eval_lvalueT a loc ofs T ->
eval_exprT (Eaddrof a ty) (Vptr loc ofs) T
| evalT_Eunop:  forall op a ty v1 v T,
eval_exprT a v1 T ->
sem_unary_operation op v1 (typeof a) m = Some v ->
(*unops at most check weak_valid_ptr, so don't create a trace event*)
eval_exprT (Eunop op a ty) v T
| evalT_Ebinop: forall op a1 a2 ty v1 v2 v T1 T2,
eval_exprT a1 v1 T1 ->
eval_exprT a2 v2 T2 ->
sem_binary_operation g op v1 (typeof a1) v2 (typeof a2) m = Some v ->
(*binops at most check weak_valid_ptr or cast, so don't create a trace event*)
eval_exprT (Ebinop op a1 a2 ty) v (T1++T2)
| evalT_Ecast:   forall a ty v1 v T,
eval_exprT a v1 T ->
sem_cast v1 (typeof a) ty m = Some v ->
eval_exprT (Ecast a ty) v T
| evalT_Esizeof: forall ty1 ty,
eval_exprT (Esizeof ty1 ty) (Vptrofs (Ptrofs.repr (@sizeof g ty1))) nil
| evalT_Ealignof: forall ty1 ty,
eval_exprT (Ealignof ty1 ty) (Vptrofs (Ptrofs.repr (@alignof g ty1))) nil
| evalT_Elvalue: forall a loc ofs v T1 T2 T,
eval_lvalueT a loc ofs T1 ->
deref_locT (typeof a) m loc ofs v T2 -> T=(T1 ++ T2) ->
eval_exprT a v T
with eval_lvalueT: expr -> block -> ptrofs -> list mem_event-> Prop :=
| evalT_Evar_local:   forall id l ty,
e!id = Some(l, ty) ->
eval_lvalueT (Evar id ty) l Ptrofs.zero nil
| evalT_Evar_global: forall id l ty,
e!id = None ->
Genv.find_symbol g id = Some l ->
eval_lvalueT (Evar id ty) l Ptrofs.zero nil
| evalT_Ederef: forall a ty l ofs T,
eval_exprT a (Vptr l ofs) T ->
eval_lvalueT (Ederef a ty) l ofs T
| evalT_Efield_struct:   forall a i ty l ofs id co att delta T,
eval_exprT a (Vptr l ofs) T ->
typeof a = Tstruct id att ->
g.(genv_cenv)!id = Some co ->
field_offset g i (co_members co) = Errors.OK delta ->
eval_lvalueT (Efield a i ty) l (Ptrofs.add ofs (Ptrofs.repr delta)) T
| evalT_Efield_union:   forall a i ty l ofs id co att T,
eval_exprT a (Vptr l ofs) T ->
typeof a = Tunion id att ->
g.(genv_cenv)!id = Some co ->
eval_lvalueT (Efield a i ty) l ofs T.
Scheme eval_exprT_ind2 := Minimality for eval_exprT Sort Prop
with eval_lvalueT_ind2 := Minimality for eval_lvalueT Sort Prop.
Combined Scheme eval_exprT_lvalue_ind from eval_exprT_ind2, eval_lvalueT_ind2.
Inductive eval_exprTlist: list expr -> typelist -> list val -> list mem_event-> Prop :=
| eval_ETnil:
eval_exprTlist nil Tnil nil nil
| eval_ETcons:   forall a bl ty tyl v1 v2 vl T1 T2,
eval_exprT a v1 T1 ->
sem_cast v1 (typeof a) ty m = Some v2 ->
eval_exprTlist bl tyl vl T2 ->
eval_exprTlist (a :: bl) (Tcons ty tyl) (v2 :: vl) (T1++T2).
End EXPR_T.
Inductive assign_locT (ce : composite_env) (ty : type) (m : mem) (b : block) (ofs : ptrofs)
: val -> mem -> list mem_event -> Prop :=
assign_locT_value : forall (v : val) (chunk : memory_chunk) (m' : mem),
access_mode ty = By_value chunk ->
Mem.storev chunk m (Vptr b ofs) v = Some m' ->
assign_locT ce ty m b ofs v m' (Write b (Ptrofs.unsigned ofs) (encode_val chunk v) ::nil)
| assign_locT_copy : forall (b' : block) (ofs' : ptrofs) (bytes : list memval) (m' : mem),
access_mode ty = By_copy ->
(@sizeof ce ty > 0 -> (alignof_blockcopy ce ty | Ptrofs.unsigned ofs')) ->
(@sizeof ce ty > 0 -> (alignof_blockcopy ce ty | Ptrofs.unsigned ofs)) ->
b' <> b \/
Ptrofs.unsigned ofs' = Ptrofs.unsigned ofs \/
Ptrofs.unsigned ofs' + @sizeof ce ty <= Ptrofs.unsigned ofs \/
Ptrofs.unsigned ofs + @sizeof ce ty <= Ptrofs.unsigned ofs' ->
Mem.loadbytes m b' (Ptrofs.unsigned ofs') (@sizeof ce ty) = Some bytes ->
Mem.storebytes m b (Ptrofs.unsigned ofs) bytes = Some m' ->
assign_locT ce ty m b ofs (Vptr b' ofs') m'
(Read b' (Ptrofs.unsigned ofs') (@sizeof ce ty) bytes ::
Write b (Ptrofs.unsigned ofs) bytes :: nil).

Lemma assign_locT_ax1 ce ty m b ofs v m' T (A:assign_locT ce ty m b ofs v m' T):
assign_loc ce ty m b ofs v m'.