Section SOUNDNESS.
Variable A V: Type.
Variable genv: Genv.t A V.
Remark type_add:
forall v1 v2, Val.has_type (Val.add v1 v2) Tint.
Remark type_addl:
forall v1 v2, Val.has_type (Val.addl v1 v2) Tlong.
Proof with (try exact I; try reflexivity; auto using Val.Vptr_has_type).
intros.
destruct op; simpl; simpl in H0; FuncInv; subst; simpl.
(* move *)
- congruence.
(* intconst, longconst, floatconst, singleconst *)
- exact I.
- exact I.
- exact I.
- exact I.
(* addrsymbol *)
- unfold Genv.symbol_address. destruct (Genv.find_symbol genv id)...
(* addrstack *)
- destruct sp... apply Val.Vptr_has_type.
(* castsigned *)
- destruct v0...
- destruct v0...
(* add, addimm *)
- apply type_add.
- apply type_add.
(* neg, sub *)
- destruct v0...
- unfold Val.sub. destruct v0; destruct v1...
unfold Val.has_type; destruct Archi.ptr64...
destruct Archi.ptr64... destruct (eq_block b b0)...
(* mul, mulhs, mulhu *)
- destruct v0; destruct v1...
- destruct v0; destruct v1...
- destruct v0; destruct v1...
(* div, divu *)
- destruct v0; destruct v1; simpl in *; inv H0.
destruct (Int.eq i0 Int.zero || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone); inv H2...
- destruct v0; destruct v1; simpl in *; inv H0.
destruct (Int.eq i0 Int.zero); inv H2...
(* mod, modu *)
- destruct v0; destruct v1; simpl in *; inv H0.
destruct (Int.eq i0 Int.zero || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone); inv H2...
- destruct v0; destruct v1; simpl in *; inv H0.
destruct (Int.eq i0 Int.zero); inv H2...
(* and, andimm *)
- destruct v0; destruct v1...
- destruct v0...
(* or, orimm *)
- destruct v0; destruct v1...
- destruct v0...
(* xor, xorimm *)
- destruct v0; destruct v1...
- destruct v0...
(* shl, shlimm *)
- destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int.iwordsize)...
- destruct v0; simpl... destruct (Int.ltu n Int.iwordsize)...
(* shr, shrimm *)
- destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int.iwordsize)...
- destruct v0; simpl... destruct (Int.ltu n Int.iwordsize)...
(* shru, shruimm *)
- destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int.iwordsize)...
- destruct v0; simpl... destruct (Int.ltu n Int.iwordsize)...
(* shrx *)
- destruct v0; simpl in H0; try discriminate. destruct (Int.ltu n (Int.repr 31)); inv H0...
(* makelong, lowlong, highlong *)
- destruct v0; destruct v1...
- destruct v0...
- destruct v0...
(* cast32 *)
- destruct v0...
- destruct v0...
(* addl, addlimm *)
- apply type_addl.
- apply type_addl.
(* negl, subl *)
- destruct v0...
- unfold Val.subl. destruct v0; destruct v1...
unfold Val.has_type; destruct Archi.ptr64...
destruct Archi.ptr64... destruct (eq_block b b0)...
(* mull, mullhs, mullhu *)
- destruct v0; destruct v1...
- destruct v0; destruct v1...
- destruct v0; destruct v1...
(* divl, divlu *)
- destruct v0; destruct v1; simpl in *; inv H0.
destruct (Int64.eq i0 Int64.zero || Int64.eq i (Int64.repr Int64.min_signed) && Int64.eq i0 Int64.mone); inv H2...
- destruct v0; destruct v1; simpl in *; inv H0.
destruct (Int64.eq i0 Int64.zero); inv H2...
(* modl, modlu *)
- destruct v0; destruct v1; simpl in *; inv H0.
destruct (Int64.eq i0 Int64.zero || Int64.eq i (Int64.repr Int64.min_signed) && Int64.eq i0 Int64.mone); inv H2...
- destruct v0; destruct v1; simpl in *; inv H0.
destruct (Int64.eq i0 Int64.zero); inv H2...
(* andl, andlimm *)
- destruct v0; destruct v1...
- destruct v0...
(* orl, orlimm *)
- destruct v0; destruct v1...
- destruct v0...
(* xorl, xorlimm *)
- destruct v0; destruct v1...
- destruct v0...
(* shll, shllimm *)
- destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int64.iwordsize')...
- destruct v0; simpl... destruct (Int.ltu n Int64.iwordsize')...
(* shr, shrimm *)
- destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int64.iwordsize')...
- destruct v0; simpl... destruct (Int.ltu n Int64.iwordsize')...
(* shru, shruimm *)
- destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int64.iwordsize')...
- destruct v0; simpl... destruct (Int.ltu n Int64.iwordsize')...
(* shrxl *)
- destruct v0; simpl in H0; try discriminate. destruct (Int.ltu n (Int.repr 63)); inv H0...
(* negf, absf *)
- destruct v0...
- destruct v0...
(* addf, subf *)
- destruct v0; destruct v1...
- destruct v0; destruct v1...
(* mulf, divf *)
- destruct v0; destruct v1...
- destruct v0; destruct v1...
(* negfs, absfs *)
- destruct v0...
- destruct v0...
(* addfs, subfs *)
- destruct v0; destruct v1...
- destruct v0; destruct v1...
(* mulfs, divfs *)
- destruct v0; destruct v1...
- destruct v0; destruct v1...
(* singleoffloat, floatofsingle *)
- destruct v0...
- destruct v0...
(* intoffloat, intuoffloat *)
- destruct v0; simpl in H0; inv H0. destruct (Float.to_int f); inv H2...
- destruct v0; simpl in H0; inv H0. destruct (Float.to_intu f); inv H2...
(* floatofint, floatofintu *)
- destruct v0; simpl in H0; inv H0...
- destruct v0; simpl in H0; inv H0...
(* intofsingle, intuofsingle *)
- destruct v0; simpl in H0; inv H0. destruct (Float32.to_int f); inv H2...
- destruct v0; simpl in H0; inv H0. destruct (Float32.to_intu f); inv H2...
(* singleofint, singleofintu *)
- destruct v0; simpl in H0; inv H0...
- destruct v0; simpl in H0; inv H0...
(* longoffloat, longuoffloat *)
- destruct v0; simpl in H0; inv H0. destruct (Float.to_long f); inv H2...
- destruct v0; simpl in H0; inv H0. destruct (Float.to_longu f); inv H2...
(* floatoflong, floatoflongu *)
- destruct v0; simpl in H0; inv H0...
- destruct v0; simpl in H0; inv H0...
(* longofsingle, longuofsingle *)
- destruct v0; simpl in H0; inv H0. destruct (Float32.to_long f); inv H2...
- destruct v0; simpl in H0; inv H0. destruct (Float32.to_longu f); inv H2...
(* singleoflong, singleoflongu *)
- destruct v0; simpl in H0; inv H0...
- destruct v0; simpl in H0; inv H0...
(* cmp *)
- destruct (eval_condition cond vl m)... destruct b...
Qed.
End SOUNDNESS.
(** * Manipulating and transforming operations *)
(** Recognition of move operations. *)
Definition is_move_operation
(A: Type) (op: operation) (args: list A) : option A :=
match op, args with
| Omove, arg :: nil => Some arg
| _, _ => None
end.
(** [negate_condition cond] returns a condition that is logically equivalent to the negation of [cond]. *)
Definition negate_condition (cond: condition): condition :=
match cond with
| Ccomp c => Ccomp(negate_comparison c)
| Ccompu c => Ccompu(negate_comparison c)
| Ccompimm c n => Ccompimm (negate_comparison c) n
| Ccompuimm c n => Ccompuimm (negate_comparison c) n
| Ccompl c => Ccompl(negate_comparison c)
| Ccomplu c => Ccomplu(negate_comparison c)
| Ccomplimm c n => Ccomplimm (negate_comparison c) n
| Ccompluimm c n => Ccompluimm (negate_comparison c) n
| Ccompf c => Cnotcompf c
| Cnotcompf c => Ccompf c
| Ccompfs c => Cnotcompfs c
| Cnotcompfs c => Ccompfs c
end.
(** Shifting stack-relative references.  This is used in [Stacking]. *)
Definition shift_stack_addressing (delta: Z) (addr: addressing) :=
match addr with
| Ainstack ofs => Ainstack (Ptrofs.add ofs (Ptrofs.repr delta))
| _ => addr
end.
Definition shift_stack_operation (delta: Z) (op: operation) :=
match op with
| Oaddrstack ofs => Oaddrstack (Ptrofs.add ofs (Ptrofs.repr delta))
| _ => op
end.
(** Offset an addressing mode [addr] by a quantity [delta], so that it designates the pointer [delta] bytes past the pointer designated by [addr].  May be undefined, in which case [None] is returned. *)
Definition offset_addressing (addr: addressing) (delta: Z) : option addressing :=
match addr with
| Aindexed n => Some(Aindexed (Ptrofs.add n (Ptrofs.repr delta)))
| Aglobal id n => Some(Aglobal id (Ptrofs.add n (Ptrofs.repr delta)))
| Ainstack n => Some(Ainstack (Ptrofs.add n (Ptrofs.repr delta)))
end.

Lemma eval_offset_addressing:
forall (F V: Type) (ge: Genv.t F V) sp addr args delta addr' v,
offset_addressing addr delta = Some addr' ->
eval_addressing ge sp addr args = Some v ->
Archi.ptr64 = false ->
eval_addressing ge sp addr' args = Some(Val.add v (Vint (Int.repr delta))).