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).
End EVAL_BUILTIN_ARG_EV.
Definition option_list_to_list {A} (x: option (list A)) : list A :=
match x with Some al => al | None => nil end.
Inductive builtin_event: external_function -> mem -> list val -> list mem_event -> Prop :=
BE_malloc: forall m n m'' b m'
(ALLOC: Mem.alloc m (-size_chunk Mptr) (Ptrofs.unsigned n) = (m'', b))
(ALGN : (align_chunk Mptr | (-size_chunk Mptr)))
(ST: Mem.storebytes m'' b (-size_chunk Mptr) (encode_val Mptr (Vptrofs n)) = Some m'),
builtin_event EF_malloc m [Vptrofs n]
[Alloc b (-size_chunk Mptr) (Ptrofs.unsigned n);
Write b (-size_chunk Mptr) (encode_val Mptr (Vptrofs n))]
| BE_free: forall m b lo bytes sz m'
(POS: Ptrofs.unsigned sz > 0)
(LB : Mem.loadbytes m b (Ptrofs.unsigned lo - size_chunk Mptr) (size_chunk Mptr) = Some bytes)
(FR: Mem.free m b (Ptrofs.unsigned lo - size_chunk Mptr) (Ptrofs.unsigned lo + Ptrofs.unsigned sz) = Some m')
(ALGN : (align_chunk Mptr | Ptrofs.unsigned lo - size_chunk Mptr))
(SZ : Vptrofs sz = decode_val Mptr bytes),
builtin_event EF_free m [Vptr b lo]
[Read b (Ptrofs.unsigned lo - size_chunk Mptr) (size_chunk Mptr) bytes;
Free [(b,Ptrofs.unsigned lo - size_chunk Mptr, Ptrofs.unsigned lo + Ptrofs.unsigned sz)]]
| BE_memcpy: forall m al bsrc bdst sz bytes osrc odst m'
(AL: al = 1 \/ al = 2 \/ al = 4 \/ al = 8)
(POS : sz >= 0)
(DIV : (al | sz))
(OSRC : sz > 0 -> (al | Ptrofs.unsigned osrc))
(ODST: sz > 0 -> (al | Ptrofs.unsigned odst))
(RNG: bsrc <> bdst \/
Ptrofs.unsigned osrc = Ptrofs.unsigned odst \/
Ptrofs.unsigned osrc + sz <= Ptrofs.unsigned odst \/ Ptrofs.unsigned odst + sz <= Ptrofs.unsigned osrc)
(LB: Mem.loadbytes m bsrc (Ptrofs.unsigned osrc) sz = Some bytes)
(ST: Mem.storebytes m bdst (Ptrofs.unsigned odst) bytes = Some m'),
builtin_event (EF_memcpy sz al) m [Vptr bdst odst; Vptr bsrc osrc]
[Read bsrc (Ptrofs.unsigned osrc) sz bytes;
Write bdst (Ptrofs.unsigned odst) bytes]
(*| BE_EFexternal: forall name sg m vargs, (*        I64Helpers.is_I64_helperS name sg ->*)
builtin_event (EF_external name sg) m vargs []
| BE_EFbuiltin: forall name sg m vargs, (*is_I64_builtinS name sg ->*)
builtin_event (EF_builtin name sg) m vargs []*)
| BE_other: forall ef m vargs,
match ef with EF_malloc | EF_free | EF_memcpy _ _ => False | _ => True end ->
builtin_event ef m vargs [].
inversion BE1; inv BE2; try discriminate; try contradiction; simpl in *; trivial.
+ assert (Vptrofs n0 = Vptrofs n) as H by congruence.
rewrite H; rewrite (Vptrofs_inj _ _ H) in *.
rewrite ALLOC0 in ALLOC; inv ALLOC; trivial.
+ inv H5.
rewrite LB0 in LB; inv LB. rewrite <- SZ in SZ0. rewrite (Vptrofs_inj _ _ SZ0); trivial.
+ inv H3; inv H5.
rewrite LB0 in LB; inv LB; trivial.
Qed.
Inductive asm_ev_step ge: state -> mem -> list mem_event -> state -> mem -> Prop :=
| exec_step_internal:
forall b ofs f i rs m1 m rs' m' T,
rs PC = Vptr b ofs ->
Genv.find_funct_ptr ge b = Some (Internal f) ->
find_instr (Ptrofs.unsigned ofs) f.(fn_code) = Some i ->
exec_instr ge f i rs m = Next rs' m' ->
drf_instr ge (fn_code f) i rs m = Some T ->
asm_ev_step ge (State rs m1) m T (State rs' m') m'
| exec_step_builtin:
forall b ofs f ef args res rs m1 m vargs t T1 T2 vres rs' m',
rs PC = Vptr b ofs ->
Genv.find_funct_ptr ge b = Some (Internal f) ->
find_instr (Ptrofs.unsigned ofs) f.(fn_code) = Some (Pbuiltin ef args res) ->
eval_builtin_args_ev _ ge rs (rs RSP) m args vargs T1 ->
builtin_event ef m vargs T2 ->
(*      ev_elim m (T1++T2) m' ->*)
(* Must it be the case that builtins don't produce trace events? *)
external_call ef ge vargs m (*nil*) t vres m' ->
rs' = nextinstr_nf
(set_res res vres
(undef_regs (map preg_of (destroyed_by_builtin ef)) rs)) ->
asm_ev_step ge (State rs m1) m (T1++T2) (State rs' m') m'.

Lemma asm_ev_elim g (Hsafe : safe_genv g): forall c m T c' m'
(Estep: asm_ev_step g c m T c' m'), ev_elim m T m'.