Section CONSTRUCTORS.
Variable ge: genv.
Variable fn: function.
(** Smart constructor for moves. *)
(** Properties of division *)
(** Smart constructor for [shrx] *)
(** Smart constructor for [shrxl] *)
(** Smart constructor for integer conversions *)
(** Smart constructor for small stores *)
(** Accessing slots in the stack frame *)
Remark eval_addrmode_indexed:
forall (base: ireg) ofs (rs: regset),
match rs#base with Vptr _ _ => True | _ => False end ->
eval_addrmode ge (Addrmode (Some base) None (inl _ (Ptrofs.unsigned ofs))) rs = Val.offset_ptr rs#base ofs.
Ltac loadind_correct_solve :=
match goal with
| H: Error _ = OK _ |- _ => discriminate H
| H: OK _ = OK _ |- _ => inv H
| H: match ?x with _ => _ end = OK _ |- _ => destruct x eqn:?; loadind_correct_solve
| _ => idtac
end.
(** Translation of addressing modes *)
(** Processor conditions and comparisons *)
Definition eval_extcond (xc: extcond) (rs: regset) : option bool :=
match xc with
| Cond_base c =>
eval_testcond c rs
| Cond_and c1 c2 =>
match eval_testcond c1 rs, eval_testcond c2 rs with
| Some b1, Some b2 => Some (b1 && b2)
| _, _ => None
end
| Cond_or c1 c2 =>
match eval_testcond c1 rs, eval_testcond c2 rs with
| Some b1, Some b2 => Some (b1 || b2)
| _, _ => None
end
end.
Definition swap_floats {A: Type} (c: comparison) (n1 n2: A) : A :=
match c with
| Clt | Cle => n2
| Ceq | Cne | Cgt | Cge => n1
end.
Remark swap_floats_commut:
forall (A B: Type) c (f: A -> B) x y, swap_floats c (f x) (f y) = f (swap_floats c x y).
Remark compare_floats_inv:
forall vx vy rs r,
r <> CR ZF -> r <> CR CF -> r <> CR PF -> r <> CR SF -> r <> CR OF ->
compare_floats vx vy rs r = rs r.
Remark compare_floats32_inv:
forall vx vy rs r,
r <> CR ZF -> r <> CR CF -> r <> CR PF -> r <> CR SF -> r <> CR OF ->
compare_floats32 vx vy rs r = rs r.
Remark eval_testcond_nextinstr:
forall c rs, eval_testcond c (nextinstr rs) = eval_testcond c rs.
Remark eval_testcond_set_ireg:
forall c rs r v, eval_testcond c (rs#(IR r) <- v) = eval_testcond c rs.
Definition negate_extcond (xc: extcond) : extcond :=
match xc with
| Cond_base c => Cond_base (negate_testcond c)
| Cond_and c1 c2 => Cond_or (negate_testcond c1) (negate_testcond c2)
| Cond_or c1 c2 => Cond_and (negate_testcond c1) (negate_testcond c2)
end.
Remark negate_testcond_for_condition:
forall cond,
negate_extcond (testcond_for_condition cond) = testcond_for_condition (negate_condition cond).
(** Translation of arithmetic operations. *)
Ltac ArgsInv :=
match goal with
| [ H: Error _ = OK _ |- _ ] => discriminate
| [ H: match ?args with nil => _ | _ :: _ => _ end = OK _ |- _ ] => destruct args; ArgsInv
| [ H: bind _ _ = OK _ |- _ ] => monadInv H; ArgsInv
| [ H: match _ with left _ => _ | right _ => assertion_failed end = OK _ |- _ ] => monadInv H; ArgsInv
| [ H: match _ with true => _ | false => assertion_failed end = OK _ |- _ ] => monadInv H; ArgsInv
| [ H: ireg_of _ = OK _ |- _ ] => simpl in *; rewrite (ireg_of_eq _ _ H) in *;
let X := fresh "EQ" in generalize (ireg_of_eq _ _ H); intros X;
clear H; ArgsInv
| [ H: freg_of _ = OK _ |- _ ] => simpl in *; rewrite (freg_of_eq _ _ H) in *; clear H; ArgsInv
| _ => idtac
end.
Ltac TranslOp :=
econstructor; split;
[ apply exec_straight_one; [ simpl; eauto | auto ]
| split; [ Simplifs | intros; Simplifs ]].
(** Translation of memory loads. *)

Lemma transl_store_correct:
forall chunk addr args src k c (rs: regset) m a m',
transl_store chunk addr args src k = OK c ->
eval_addressing ge (rs#RSP) addr (map rs (map preg_of args)) = Some a ->
Mem.storev chunk m a (rs (preg_of src)) = Some m' ->
exists rs',
exec_straight ge fn c rs m k rs' m'
/\ forall r, data_preg r = true -> preg_notin r (destroyed_by_store chunk addr) -> rs'#r = rs#r.