Proof with eauto with wd.
intros; intro r; unfold Pregmap.get...
Qed.
Hint Resolve valid_val_addrmode valid_val_addrmode64
regset_wd_compare_floats regset_wd_compare_floats32
regset_wd_compare_ints regset_wd_compare_longs : wd.
End X86WD.
(** ** Injections/Renamings on X86 cores *)
Module X86Inj.
(** Injections on registers *)
Definition reg_ren f (r:PregEq.t) (rs rs' : regset) : Prop :=
val_obs f (Pregmap.get r rs) (Pregmap.get r rs').
Definition regset_ren f rs rs' : Prop :=
forall r, reg_ren f r rs rs'.
Definition core_inj f c c' :=
match c, c' with State rs _, State rs' _ => regset_ren f rs rs' end.
Include X86WD.
(* Lemma decode_longs_val_obs_list: forall f (vals vals' : seq val) tys (Hobs_eq: val_obs_list f vals vals'), val_obs_list f (val_casted.decode_longs tys vals) (val_casted.decode_longs tys vals'). *)

(* Specifications: *)
(* Lemma set_res_empty_1: forall regs rs, set_res regs [::] rs = rs.  Lemma set_regs_empty_2: forall vs rs, set_regs [::] vs rs = rs.  Lemma set_regs_gsspec_1: forall r regs v rs, Pregmap.get r (set_regs (r :: regs) [:: v] rs) = v.  Lemma set_regs_gsspec_2: forall r r' regs v rs, r <> r' -> Pregmap.get r (set_regs (r' :: regs) [:: v] rs) = Pregmap.get r rs.  Lemma get_reg_renC: forall f r rs rs', regset_ren f rs rs' -> rs' r = val_obsC f (rs r).  Lemma get_reg_ren: forall f r rs rs' v, regset_ren f rs rs' -> rs r = v -> exists v', rs' r = v' /\ val_obs f v v'.  Lemma val_obs_reg: forall f r rs rs', regset_ren f rs rs' -> val_obs f (rs r) (rs' r).  Lemma regset_ren_trans: forall f f' f'' rs rs' rs'', regset_ren f rs rs'' -> regset_ren f' rs rs' -> (forall b b' b'' : block, f b = Some b'' -> f' b = Some b' -> f'' b' = Some b'') -> regset_ren f'' rs' rs''.  Lemma regset_ren_id: forall f rs (Hregset_wd: regset_wd f rs) (Hf: forall b1 b2, f b1 = Some b2 -> b1 = b2), regset_ren f rs rs.  Lemma regset_ren_incr: forall f f' rs rs' (Hrs_ren: regset_ren f rs rs') (Hincr: ren_incr f f'), regset_ren f' rs rs'. Proof with eauto with val_renamings. unfold regset_ren, reg_ren in *... Qed.  Lemma regset_ren_set: forall f rs rs' v v' r (Hrs_ren: regset_ren f rs rs') (Hval_obs: val_obs f v v'), regset_ren f (rs # r <- v) (rs' # r <- v').  Lemma regset_ren_init: forall f v v' (Hval_obs: val_obs f v v'), regset_ren f (Pregmap.init v) (Pregmap.init v').  Lemma regset_ren_set_res: forall f br rs rs' v v' (Hrs_ren: regset_ren f rs rs') (Hval_obs: val_obs f v v'), regset_ren f (set_res br v rs) (set_res br v' rs').  Lemma gso_undef_regs: forall (rs : regset) r regs, ~ List.In r regs -> (undef_regs regs rs) r = rs r.  Lemma valid_val_ge_id: forall fg f b i (Hvalid: valid_val fg (Vptr b i)) (Hincr: ren_incr fg f) (Hfg: forall b1 b2, fg b1 = Some b2 -> b1 = b2), f b = Some b.  Hint Resolve val_obs_reg regset_ren_set regset_ren_set_res : reg_renamings. Hint Rewrite gso_undef_regs : reg_renamings.  Hint Resolve valid_val_ge_id  : ge_renamings. Hint Constructors eval_builtin_arg : renamings. Hint Unfold Vone Vzero nextinstr nextinstr_nf : renamings.  Lemma val_obs_symb: forall f fg g id i (Hge_wd: ge_wd fg g) (Hincr: ren_incr fg f) (Hfg: forall b1 b2, fg b1 = Some b2 -> b1 = b2), val_obs f (symbol_address g id i) (symbol_address g id i). Proof with eauto with ge_renamings renamings val_renamings. intros. destruct Hge_wd as (H1 & H2). unfold symbol_address, Senv.symbol_address in *; simpl in *. specialize (H2 id i _ ltac:(reflexivity)). destruct (find_symbol g id)... Qed.  Hint Resolve val_obs_symb : ge_renamings.  Lemma regset_ren_undef: forall f rs rs' regs (Hrs_ren: regset_ren f rs rs'), regset_ren f (undef_regs regs rs) (undef_regs regs rs'). Proof with eauto with renamings reg_renamings val_renamings. intros. induction regs as [|r regs]; simpl; auto. intros r'. unfold reg_ren. do 2 rewrite undef_regs_comm; do 2 rewrite Pregmap.gsspec; unfold Pregmap.get; destruct (Pregmap.elt_eq r' r)... Qed.  Hint Resolve regset_ren_undef : reg_renamings.  Lemma ge_wd_incr : forall (f f' : memren) (g : genv), ge_wd f g -> ren_domain_incr f f' -> ge_wd f' g. Proof with (eauto with renamings val_renamings). intros. unfold ge_wd in *. destruct H as (? & ?); repeat split; intros... Qed.  Lemma ge_wd_domain : forall (f f' : memren) (m : mem) (g : genv), ge_wd f g -> domain_memren f m -> domain_memren f' m -> ge_wd f' g.  Lemma get_extcall_arg_wd : forall f rs m l v (Hm : valid_mem m) (Hdom : domain_memren f m) (Hrs : regset_wd f rs) (Hv : get_extcall_arg rs m l = Some v), valid_val f v.  Lemma get_extcall_arguments_wd : forall f rs m l v (Hm : valid_mem m) (Hdom : domain_memren f m) (Hrs : regset_wd f rs) (Hv : get_extcall_arguments rs m l = Some v), valid_val_list f v.  Lemma at_external_wd : forall the_ge m (f : memren) c (ef : external_function) (args : seq val), valid_mem m -> domain_memren f m -> core_wd f c -> semantics.at_external (Asm_core_sem the_ge) c m = Some (ef, args) -> valid_val_list f args.  Lemma valid_val_hiword: forall f v, valid_val f v -> valid_val f (Val.hiword v).  Lemma valid_val_loword: forall f v, valid_val f v -> valid_val f (Val.loword v).  Hint Resolve valid_val_loword valid_val_loword : wd.  Lemma after_external_wd : forall the_ge m (c c' : state) (f : memren) (ef : external_function) (args : seq val) (ov : option val) (Hat_external: semantics.at_external (Asm_core_sem the_ge) c m = Some (ef, args)) (Hcore_wd: core_wd f c) (Hvalid_list: valid_val_list f args) (Hafter_external: semantics.after_external (Asm_core_sem the_ge) ov c m = Some c') (Hov: match ov with | Some v => valid_val f v | None => True end), core_wd f c'.  Lemma valid_val_nullptr : forall f, valid_val f Vnullptr.  Lemma make_arg_wd: forall f rs rs' m m' loc arg (Hrs_wd: regset_wd f rs) (Hmem_wd: valid_mem m) (Hdomain: domain_memren f m) (Hvalid_val: valid_val f arg) (Hmake_args: make_arg rs m loc arg = Some (rs', m')), regset_wd f rs' /\ valid_mem m' /\ domain_memren f m'.  Lemma make_arguments_wd: forall f rs rs' m m' loc args (Hrs_wd: regset_wd f rs) (Hmem_wd: valid_mem m) (Hdomain: domain_memren f m) (Hvalid_val: valid_val_list f args) (Hmake_args: make_arguments rs m loc args = Some (rs', m')), regset_wd f rs' /\ valid_mem m' /\ domain_memren f m'.  Lemma mem_valid_alloc: forall m m' b lo hi f (Hdomain: domain_memren f m) (Hvalid_mem: valid_mem m) (Halloc: Mem.alloc m lo hi = (m', b)), valid_mem m' /\ (exists f', ren_domain_incr f f' /\ domain_memren f' m').  Lemma initial_core_wd : forall the_ge m m' (f fg : memren) (vf : val) args (c_new : state) h, valid_mem m -> domain_memren f m -> initial_core (Asm_core_sem the_ge) h m c_new m' vf args -> valid_val_list f args -> ge_wd fg the_ge -> ren_domain_incr fg f -> valid_mem m' /\ (exists f', ren_domain_incr f f' /\ domain_memren f' m') /\ forall f', domain_memren f' m' -> core_wd f' c_new.  Lemma get_extcall_arg_inj : forall f rs rs' m m' l v, regset_ren f rs rs' -> mem_obs_eq f m m' -> get_extcall_arg rs m l = Some v -> exists v', get_extcall_arg rs' m' l = Some v' /\ val_obs f v v'.  Lemma get_extcall_arguments_inj : forall f rs rs' m m' l v, regset_ren f rs rs' -> mem_obs_eq f m m' -> get_extcall_arguments rs m l = Some v -> exists v', get_extcall_arguments rs' m' l = Some v' /\ val_obs_list f v v'.  Lemma get_extcall_arg_inj' : forall f rs rs' m m' l, regset_ren f rs rs' -> mem_obs_eq f m m' -> get_extcall_arg rs m l = None -> get_extcall_arg rs' m' l = None.  Lemma get_extcall_arguments_inj' : forall f rs rs' m m' l, regset_ren f rs rs' -> mem_obs_eq f m m' -> get_extcall_arguments rs m l = None -> get_extcall_arguments rs' m' l = None.  Lemma find_funct_ptr_inj : forall g (f fg : memren) b b' h (Hfg: forall b1 b2, fg b1 = Some b2 -> b1 = b2) (Hge_wd: ge_wd fg g) (Hincr: ren_incr fg f), find_funct_ptr g b = Some h -> f b = Some b' -> b' = b.  Lemma find_funct_ptr_inj' : forall g (f fg : memren) m m' b b' h (Hfg: forall b1 b2, fg b1 = Some b2 -> b1 = b2) (Hge_wd: ge_wd fg g) (Hincr: ren_incr fg f) (Hmem : mem_obs_eq f m m'), find_funct_ptr g b' = Some h -> f b = Some b' -> b' = b.  Lemma core_inj_ext : forall the_ge m m' c c' (f fg : memren) (Hfg: forall b1 b2, fg b1 = Some b2 -> b1 = b2) (Hge_wd: ge_wd fg the_ge) (Hincr: ren_incr fg f) (Hc : core_wd f c) (Hinj : core_inj f c c') (Hmem : mem_obs_eq f m m'), match semantics.at_external (Asm_core_sem the_ge) c m with | Some (ef, vs) => match semantics.at_external (Asm_core_sem the_ge) c' m' with | Some (ef', vs') => ef = ef' /\ val_obs_list f vs vs' | None => False end | None => match semantics.at_external (Asm_core_sem the_ge) c' m' with | Some _ => False | None => True end end.  Lemma core_inj_after_ext : forall the_ge c cc c' (ov1 : option val) m m' (f fg : memren) (Hfg: forall b1 b2, fg b1 = Some b2 -> b1 = b2) (Hge_wd: ge_wd fg the_ge) (Hincr: ren_incr fg f), core_inj f c c' -> mem_obs_eq f m m' -> match ov1 with | Some v1 => valid_val f v1 | None => True end -> semantics.after_external (Asm_core_sem the_ge) ov1 c m = Some cc -> exists (ov2 : option val) (cc' : state), semantics.after_external (Asm_core_sem the_ge) ov2 c' m' = Some cc' /\ core_inj f cc cc' /\ match ov1 with | Some v1 => match ov2 with | Some v2 => val_obs f v1 v2 | None => False end | None => match ov2 with | Some _ => False | None => True end end.  Lemma core_inj_halted : forall the_ge c c' (f : memren), core_inj f c c' -> forall v, halted (Asm_core_sem the_ge) c v <-> halted (Asm_core_sem the_ge) c' v.  Lemma val_obs_inj : forall f v v1 v2, val_obs f v v1 -> val_obs f v v2 -> v1 = v2.  Lemma val_obs_list_inj : forall f v v1 v2, val_obs_list f v v1 -> val_obs_list f v v2 -> v1 = v2.  Lemma make_arg_inj: forall (f : memren) (rs rs1 rs' : regset) (m m1 m' : mem) l (arg arg' : val) (Hrs: regset_ren f rs rs') (Hmem_obs_eq: mem_obs_eq f m m') (Hval_obs_list: val_obs f arg arg') (Hmake: make_arg rs m l arg = Some (rs1, m1)), exists rs1' m1', make_arg rs' m' l arg' = Some (rs1', m1') /\ regset_ren f rs1 rs1' /\ mem_obs_eq f m1 m1'.  Lemma make_arguments_inj: forall (f : memren) (l : seq (rpair Locations.loc)) (rs rs1 rs' : regset) (m m1 m' : mem) (arg arg' : seq val) (Hrs: regset_ren f rs rs') (Hmem_obs_eq: mem_obs_eq f m m') (Hval_obs_list: val_obs_list f arg arg') (Hmake: make_arguments rs m l arg = Some (rs1, m1)), exists rs1' m1', make_arguments rs' m' l arg' = Some (rs1', m1') /\ regset_ren f rs1 rs1' /\ mem_obs_eq f m1 m1'.  (*TODO: move to memorylemmas*)
Lemma nextblock_storev :
forall chunk  (m1 : mem) (vptr v : val) (m2 : mem),
Mem.storev chunk m1 vptr v = Some m2 ->
Mem.nextblock m2 = Mem.nextblock m1.
Lemma core_inj_init :
forall the_ge m1 m1' m2 vf vf' arg arg' c_new f fg h
(Hge_wd: ge_wd fg the_ge)
(Hfg: forall b1 b2, fg b1 = Some b2 -> b1 = b2)
(Hincr: ren_incr fg f)
(Harg: val_obs_list f arg arg')
(Hvf: val_obs f vf vf')
(Hmem_obs_eq: mem_obs_eq f m1 m1')
(Hinit: initial_core (Asm_core_sem the_ge) h m1 c_new m2 vf arg),
exists c_new' m2' f',
initial_core (Asm_core_sem the_ge) h m1' c_new' m2' vf' arg'
/\ core_inj f' c_new c_new'
/\ mem_obs_eq f' m2 m2'
/\ ren_incr f f'
/\ ren_separated f f' m1 m1'
/\ ((exists p, ((Mem.nextblock m2 = Mem.nextblock m1 + p)%positive /\
(Mem.nextblock m2' = Mem.nextblock m1' + p)%positive)))
/\ (forall b,
Mem.valid_block m2' b ->
~ Mem.valid_block m1' b ->
let bz := ((Zpos b) - ((Zpos (Mem.nextblock m1')) -
(Zpos (Mem.nextblock m1))))%Z in
f' (Z.to_pos bz) = Some b /\
f (Z.to_pos bz) = None)
/\ (Mem.nextblock m1 = Mem.nextblock m1' ->
(forall b1 b2, f b1 = Some b2 -> b1 = b2) ->
forall b1 b2, f' b1 = Some b2 -> b1 = b2)
/\ (forall b2, (~exists b1, f' b1 = Some b2) ->
forall ofs, permissions.permission_at m1' b2 ofs Cur =
permissions.permission_at m2' b2 ofs Cur).
Lemma core_inj_id :
forall c (f : memren),
core_wd f c ->
(forall b1 b2 : block, f b1 = Some b2 -> b1 = b2) -> core_inj f c c.
Lemma core_inj_trans :
forall c c' c'' (f f' f'' : memren),
core_inj f c c'' ->
core_inj f' c c' ->
(forall b b' b'' : block,
f b = Some b'' -> f' b = Some b' -> f'' b' = Some b'') ->
core_inj f'' c' c''.