(* Notation SP := ESP (only parsing).  Notation "a # b" := (a b) (at level 1, only parsing). Notation "a # b <- c" := (Pregmap.set b c a) (at level 1, b at next level). *)
Section ASM_EV.
(*Variable hf : I64Helpers.helper_functions.*)
Definition drf_instr (ge:genv) (c: code) (i: instruction) (rs: regset) (m: mem)
: option (list mem_event)  :=
match i with
| Pfstps_m a => match eval_addrmode ge a rs with
Vptr b ofs => Some [Write b (Ptrofs.unsigned ofs) (encode_val Mfloat32 (rs ST0))]
| _ => None
end
| Pfstpl_m a => match eval_addrmode ge a rs with
Vptr b ofs => Some [Write b (Ptrofs.unsigned ofs) (encode_val Mfloat64 (rs ST0))]
| _ => None
end
| Pmovss_mf a r1 => match eval_addrmode ge a rs with
Vptr b ofs => Some [Write b (Ptrofs.unsigned ofs) (encode_val Mfloat32 (rs r1))]
| _ => None
end
| Pmovl_mr a r1 => match eval_addrmode ge a rs with
Vptr b ofs => Some [Write b (Ptrofs.unsigned ofs) (encode_val Mint32 (rs r1))]
| _ => None
end
| Pmovq_mr a r1 => match eval_addrmode ge a rs with
Vptr b ofs => Some [Write b (Ptrofs.unsigned ofs) (encode_val Mint64 (rs r1))]
| _ => None
end
| Pmov_mr_a a r1 => match eval_addrmode ge a rs with
Vptr b ofs => Some [Write b (Ptrofs.unsigned ofs) (encode_val Many32 (rs r1))]
| _ => None
end
| Pmovsd_mf a r1 => match eval_addrmode ge a rs with
Vptr b ofs => Some [Write b (Ptrofs.unsigned ofs) (encode_val Mfloat64 (rs r1))]
| _ => None
end
| Pmovsd_mf_a a r1 => match eval_addrmode ge a rs with
Vptr b ofs => Some [Write b (Ptrofs.unsigned ofs)  (encode_val Many64 (rs r1))]
| _ => None
end
| Pmovb_mr a r1 => match eval_addrmode ge a rs with
Vptr b ofs => Some [Write b (Ptrofs.unsigned ofs) (encode_val Mint8unsigned (rs r1))]
| _ => None
end
| Pmovw_mr a r1 => match eval_addrmode ge a rs with
Vptr b ofs => Some [Write b (Ptrofs.unsigned ofs) (encode_val Mint16unsigned (rs r1))]
| _ => None
end
| Pmovl_rm rd a => match eval_addrmode ge a rs with
Vptr b ofs => match Mem.loadbytes m b (Ptrofs.unsigned ofs) (size_chunk Mint32) with
Some bytes => Some [Read b (Ptrofs.unsigned ofs) (size_chunk Mint32) bytes]
| None => None
end
| _ => None
end
| Pmovq_rm rd a => match eval_addrmode ge a rs with
Vptr b ofs => match Mem.loadbytes m b (Ptrofs.unsigned ofs) (size_chunk Mint64) with
Some bytes => Some [Read b (Ptrofs.unsigned ofs) (size_chunk Mint64) bytes]
| None => None
end
| _ => None
end
| Pmovsd_fm rd a => match eval_addrmode ge a rs with
Vptr b ofs => match Mem.loadbytes m b (Ptrofs.unsigned ofs) (size_chunk Mfloat64) with
Some bytes => Some [Read b (Ptrofs.unsigned ofs) (size_chunk Mfloat64) bytes]
| None => None
end
| _ => None
end
| Pmovss_fm rd a => match eval_addrmode ge a rs with
Vptr b ofs => match Mem.loadbytes m b (Ptrofs.unsigned ofs) (size_chunk Mfloat32) with
Some bytes => Some [Read b (Ptrofs.unsigned ofs) (size_chunk Mfloat32) bytes]
| None => None
end
| _ => None
end
| Pfldl_m a => match eval_addrmode ge a rs with
Vptr b ofs => match Mem.loadbytes m b (Ptrofs.unsigned ofs) (size_chunk Mfloat64) with
Some bytes => Some [Read b (Ptrofs.unsigned ofs) (size_chunk Mfloat64) bytes]
| None => None
end
| _ => None
end
| Pflds_m a => match eval_addrmode ge a rs with
Vptr b ofs => match Mem.loadbytes m b (Ptrofs.unsigned ofs) (size_chunk Mfloat32) with
Some bytes => Some [Read b (Ptrofs.unsigned ofs) (size_chunk Mfloat32) bytes]
| None => None
end
| _ => None
end
| Pmovzb_rm rd a => match eval_addrmode ge a rs with
Vptr b ofs => match Mem.loadbytes m b (Ptrofs.unsigned ofs) (size_chunk Mint8unsigned) with
Some bytes => Some [Read b (Ptrofs.unsigned ofs) (size_chunk Mint8unsigned) bytes]
| None => None
end
| _ => None
end
| Pmovsb_rm rd a => match eval_addrmode ge a rs with
Vptr b ofs => match Mem.loadbytes m b (Ptrofs.unsigned ofs) (size_chunk Mint8signed) with
Some bytes => Some [Read b (Ptrofs.unsigned ofs) (size_chunk Mint8signed) bytes]
| None => None
end
| _ => None
end
| Pmovzw_rm rd a => match eval_addrmode ge a rs with
Vptr b ofs => match Mem.loadbytes m b (Ptrofs.unsigned ofs) (size_chunk Mint16unsigned) with
Some bytes => Some [Read b (Ptrofs.unsigned ofs) (size_chunk Mint16unsigned) bytes]
| None => None
end
| _ => None
end
| Pmovsw_rm rd a => match eval_addrmode ge a rs with
Vptr b ofs => match Mem.loadbytes m b (Ptrofs.unsigned ofs) (size_chunk Mint16signed) with
Some bytes => Some [Read b (Ptrofs.unsigned ofs) (size_chunk Mint16signed) bytes]
| None => None
end
| _ => None
end
| Pmov_rm_a rd a =>
match eval_addrmode ge a rs with
Vptr b ofs =>
match Mem.loadbytes m b (Ptrofs.unsigned ofs) (size_chunk (if Archi.ptr64 then Many64 else Many32)) with
Some bytes => Some [Read b (Ptrofs.unsigned ofs) (size_chunk (if Archi.ptr64 then Many64 else Many32)) bytes]
| None => None
end
| _ => None
end
| Pmovsd_fm_a rd a => match eval_addrmode ge a rs with
Vptr b ofs => match Mem.loadbytes m b (Ptrofs.unsigned ofs) (size_chunk Many64) with
Some bytes => Some [Read b (Ptrofs.unsigned ofs) (size_chunk Many64) bytes]
| None => None
end
| _ => None
end
| Pallocframe sz ofs_ra ofs_link =>
let (m1, stk) := Mem.alloc m 0 sz in
let sp := Vptr stk Ptrofs.zero in
match Mem.storev Mptr m1 (Val.offset_ptr sp ofs_link) rs#RSP with
| None => None
| Some m2 =>
match Mem.storev Mptr m2 (Val.offset_ptr sp ofs_ra) rs#RA with
| None => None
| Some m3 => Some [Alloc stk 0 sz;
Write stk (Ptrofs.unsigned ofs_link) (encode_val Mptr (rs RSP));
Write stk (Ptrofs.unsigned ofs_ra) (encode_val Mptr (rs RA))]
end
end
| Pfreeframe sz ofs_ra ofs_link =>
match Mem.loadv Mptr m (Val.offset_ptr rs#RSP ofs_ra) with
| None => None
| Some ra =>
match Mem.loadv Mptr m (Val.offset_ptr rs#RSP ofs_link) with
| None => None
| Some sp =>
match rs#RSP with
| Vptr stk ofs =>
match Mem.free m stk 0 sz with
| None => None
| Some m' => match (Val.offset_ptr rs#RSP ofs_ra), (Val.offset_ptr rs#RSP ofs_link) with
Vptr b1 ofs1, Vptr b2 ofs2 =>
match Mem.loadbytes m b1 (Ptrofs.unsigned ofs1) (size_chunk Mptr), Mem.loadbytes m b2 (Ptrofs.unsigned ofs2) (size_chunk Mptr)
with Some bytes1, Some bytes2=>
Some [Read b1 (Ptrofs.unsigned ofs1) (size_chunk Mptr) bytes1;
Read b2 (Ptrofs.unsigned ofs2) (size_chunk Mptr) bytes2;
Free [(stk, 0, sz)]]
| _, _ => None
end
| _, _ => None
end
end
| _ => None
end
end
end
(*  | Pbuiltin ef args res => EmptyEffect (*     (BuiltinEffect ge ef (decode_longs (sig_args (ef_sig ef)) (map rs args)) m)*)
(*  | Pannot ef args => EmptyEffect *)*)
| _ => Some [Free nil]
end.
Section EVAL_BUILTIN_ARG_EV.
Variable A: Type.
Variable ge: Senv.t.
Variable e: A -> val.
Variable sp: val.
Variable m: mem.
Inductive eval_builtin_arg_ev: builtin_arg A -> val -> list mem_event -> Prop :=
| eval_BA_ev: forall x,
eval_builtin_arg_ev (BA x) (e x) nil
| eval_BA_ev_int: forall n,
eval_builtin_arg_ev (BA_int n) (Vint n) nil
| eval_BA_ev_long: forall n,
eval_builtin_arg_ev (BA_long n) (Vlong n) nil
| eval_BA_ev_float: forall n,
eval_builtin_arg_ev (BA_float n) (Vfloat n) nil
| eval_BA_ev_single: forall n,
eval_builtin_arg_ev (BA_single n) (Vsingle n) nil
| eval_BA_ev_loadstack: forall chunk ofs v b z bytes,
Mem.loadv chunk m (Val.offset_ptr sp ofs) = Some v ->
(align_chunk chunk | (Ptrofs.unsigned z)) ->
Mem.loadbytes m b (Ptrofs.unsigned z) (size_chunk chunk) = Some bytes ->
v= decode_val chunk bytes ->
Val.offset_ptr sp ofs = Vptr b z ->
eval_builtin_arg_ev (BA_loadstack chunk ofs) v [Read b (Ptrofs.unsigned z) (size_chunk chunk) bytes]
| eval_BA_ev_addrstack: forall ofs,
eval_builtin_arg_ev (BA_addrstack ofs) (Val.offset_ptr sp ofs) nil
| eval_BA_ev_loadglobal: forall chunk id ofs v b z bytes,
Mem.loadv chunk m (Senv.symbol_address ge id ofs) = Some v ->
(align_chunk chunk | (Ptrofs.unsigned z)) ->
Mem.loadbytes m b (Ptrofs.unsigned z) (size_chunk chunk) = Some bytes ->
v= decode_val chunk bytes ->
Senv.symbol_address ge id ofs = Vptr b z ->
eval_builtin_arg_ev (BA_loadglobal chunk id ofs) v [Read b (Ptrofs.unsigned z) (size_chunk chunk) bytes]
| eval_BA_ev_addrglobal: forall id ofs,
eval_builtin_arg_ev (BA_addrglobal id ofs) (Senv.symbol_address ge id ofs) nil
| eval_BA_ev_splitlong: forall hi lo vhi vlo Thi Tlo,
eval_builtin_arg_ev hi vhi Thi -> eval_builtin_arg_ev lo vlo Tlo->
eval_builtin_arg_ev (BA_splitlong hi lo) (Val.longofwords vhi vlo) (Thi++Tlo)
| eval_BA_ev_addptr: forall a1 a2 v1 v2 T1 T2,
eval_builtin_arg_ev a1 v1 T1 -> eval_builtin_arg_ev a2 v2 T2->
eval_builtin_arg_ev (BA_addptr a1 a2) (if Archi.ptr64 then Val.addl v1 v2 else Val.add v1 v2) (T1++T2).

Lemma eval_builtin_arg_event_inv: forall a v T, eval_builtin_arg_ev a v T -> eval_builtin_arg ge e sp m a v.