Section CONSTRUCTORS.
Variable ge: genv.
Variable fn: function.
(** Decomposition of integer literals *)
Inductive wf_decomposition: list (Z * Z) -> Prop :=
| wf_decomp_nil:
wf_decomposition nil
| wf_decomp_cons: forall m n p l,
n = Zzero_ext 16 m -> 0 <= p -> wf_decomposition l ->
wf_decomposition ((n, p) :: l).
Fixpoint recompose_int (accu: Z) (l: list (Z * Z)) : Z :=
match l with
| nil => accu
| (n, p) :: l => recompose_int (Zinsert accu n p 16) l
end.
(** Add immediate *)
(** Logical immediate *)
(** Load address of symbol *)
(** Shifted operands *)
Remark transl_shift_not_none:
forall s a, transl_shift s a <> SOnone.
Remark or_zero_eval_shift_op_int:
forall v s, s <> SOnone -> Val.or (Vint Int.zero) (eval_shift_op_int v s) = eval_shift_op_int v s.
Remark or_zero_eval_shift_op_long:
forall v s, s <> SOnone -> Val.orl (Vlong Int64.zero) (eval_shift_op_long v s) = eval_shift_op_long v s.
Remark add_zero_eval_shift_op_long:
forall v s, s <> SOnone -> Val.addl (Vlong Int64.zero) (eval_shift_op_long v s) = eval_shift_op_long v s.
(** Zero- and Sign- extensions *)
(** Extended right shift *)
(** Condition bits *)
Remark int64_sub_overflow:
forall x y,
Int.xor (Int.repr (Int64.unsigned (Int64.sub_overflow x y Int64.zero)))
(Int.repr (Int64.unsigned (Int64.negative (Int64.sub x y)))) =
(if Int64.lt x y then Int.one else Int.zero).
Remark compare_float_inv: forall rs v1 v2 r,
match r with CR _ => False | _ => True end ->
(nextinstr (compare_float rs v1 v2))#r = (nextinstr rs)#r.
Remark compare_single_inv: forall rs v1 v2 r,
match r with CR _ => False | _ => True end ->
(nextinstr (compare_single rs v1 v2))#r = (nextinstr rs)#r.
(** Translation of conditionals *)
Ltac ArgsInv :=
repeat (match goal with
| [ H: Error _ = OK _ |- _ ] => discriminate
| [ H: match ?args with nil => _ | _ :: _ => _ end = OK _ |- _ ] => destruct args
| [ H: bind _ _ = OK _ |- _ ] => monadInv H
| [ H: match _ with left _ => _ | right _ => assertion_failed end = OK _ |- _ ] => monadInv H; ArgsInv
| [ H: match _ with true => _ | false => assertion_failed end = OK _ |- _ ] => monadInv H; ArgsInv
end);
subst;
repeat (match goal with
| [ H: ireg_of _ = OK _ |- _ ] => simpl in *; rewrite (ireg_of_eq _ _ H) in *
| [ H: freg_of _ = OK _ |- _ ] => simpl in *; rewrite (freg_of_eq _ _ H) in *
end).
(** Translation of conditional branches *)
(** Translation of arithmetic operations *)
Ltac SimplEval H :=
match type of H with
| Some _ = None _ => discriminate
| Some _ = Some _ => inv H
| ?a = Some ?b => let A := fresh in assert (A: Val.maketotal a = b) by (rewrite H; reflexivity)
end.
Ltac TranslOpSimpl :=
econstructor; split;
[ apply exec_straight_one; [simpl; eauto | reflexivity]
| split; [ rewrite ? transl_eval_shift, ? transl_eval_shiftl;
apply Val.lessdef_same; Simpl; fail
| intros; Simpl; fail ] ].
Ltac TranslOpBase :=
econstructor; split;
[ apply exec_straight_one; [simpl; eauto | reflexivity]
| split; [ rewrite ? transl_eval_shift, ? transl_eval_shiftl; Simpl
| intros; Simpl; fail ] ].
(** Translation of addressing modes, loads, stores *)

Lemma transl_addressing_correct:
forall sz addr args (insn: Asm.addressing -> instruction) k (rs: regset) m c b o,
transl_addressing sz addr args insn k = OK c ->
Op.eval_addressing ge (rs#SP) addr (map rs (map preg_of args)) = Some (Vptr b o) ->
exists ad rs',
exec_straight_opt ge fn c rs m (insn ad :: k) rs' m
/\ Asm.eval_addressing ge ad rs' = Vptr b o
/\ forall r, data_preg r = true -> rs' r = rs r.