(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)
(** Operators and addressing modes.  The abstract syntax and dynamic semantics for the CminorSel, RTL, LTL and Mach languages depend on the following types, defined in this library: - [condition]:  boolean conditions for conditional branches; - [operation]: arithmetic and logical operations; - [addressing]: addressing modes for load and store operations.  These types are X86-64-specific and correspond roughly to what the processor can compute in one instruction.  In other terms, these types reflect the state of the program after instruction selection. For a processor-independent set of operations, see the abstract syntax and dynamic semantics of the Cminor language. *)
Set Implicit Arguments.
(** Conditions (boolean-valued operators). *)
Inductive condition : Type :=
| Ccomp (c: comparison)      (**r signed integer comparison *)
| Ccompu (c: comparison)     (**r unsigned integer comparison *)
| Ccompimm (c: comparison) (n: int) (**r signed integer comparison with a constant *)
| Ccompuimm (c: comparison) (n: int)  (**r unsigned integer comparison with a constant *)
| Ccompl (c: comparison)      (**r signed 64-bit integer comparison *)
| Ccomplu (c: comparison)     (**r unsigned 64-bit integer comparison *)
| Ccomplimm (c: comparison) (n: int64) (**r signed 64-bit integer comparison with a constant *)
| Ccompluimm (c: comparison) (n: int64)  (**r unsigned 64-bit integer comparison with a constant *)
| Ccompf (c: comparison)     (**r 64-bit floating-point comparison *)
| Cnotcompf (c: comparison)  (**r negation of a floating-point comparison *)
| Ccompfs (c: comparison)    (**r 32-bit floating-point comparison *)
| Cnotcompfs (c: comparison) (**r negation of a floating-point comparison *)
| Cmaskzero (n: int)         (**r test [(arg & constant) == 0] *)
| Cmasknotzero (n: int).     (**r test [(arg & constant) != 0] *)
(** Addressing modes.  [r1], [r2], etc, are the arguments to the addressing. *)
Inductive addressing: Type :=
| Aindexed: Z -> addressing       (**r Address is [r1 + offset] *)
| Aindexed2: Z -> addressing      (**r Address is [r1 + r2 + offset] *)
| Ascaled: Z -> Z -> addressing   (**r Address is [r1 * scale + offset] *)
| Aindexed2scaled: Z -> Z -> addressing
(**r Address is [r1 + r2 * scale + offset] *)
| Aglobal: ident -> ptrofs -> addressing (**r Address is [symbol + offset] *)
| Abased: ident -> ptrofs -> addressing  (**r Address is [symbol + offset + r1] *)
| Abasedscaled: Z -> ident -> ptrofs -> addressing  (**r Address is [symbol + offset + r1 * scale] *)
| Ainstack: ptrofs -> addressing. (**r Address is [stack_pointer + offset] *)
(** Arithmetic and logical operations.  In the descriptions, [rd] is the result of the operation and [r1], [r2], etc, are the arguments. *)
Inductive operation : Type :=
| Omove                    (**r [rd = r1] *)
| Ointconst (n: int)       (**r [rd] is set to the given integer constant *)
| Olongconst (n: int64)    (**r [rd] is set to the given integer constant *)
| Ofloatconst (n: float)   (**r [rd] is set to the given float constant *)
| Osingleconst (n: float32)(**r [rd] is set to the given float constant *)
| Oindirectsymbol (id: ident) (**r [rd] is set to the address of the symbol *)
(*c 32-bit integer arithmetic: *)
| Ocast8signed             (**r [rd] is 8-bit sign extension of [r1] *)
| Ocast8unsigned           (**r [rd] is 8-bit zero extension of [r1] *)
| Ocast16signed            (**r [rd] is 16-bit sign extension of [r1] *)
| Ocast16unsigned          (**r [rd] is 16-bit zero extension of [r1] *)
| Oneg                     (**r [rd = - r1] *)
| Osub                     (**r [rd = r1 - r2] *)
| Omul                     (**r [rd = r1 * r2] *)
| Omulimm (n: int)         (**r [rd = r1 * n] *)
| Omulhs                   (**r [rd = high part of r1 * r2, signed] *)
| Omulhu                   (**r [rd = high part of r1 * r2, unsigned] *)
| Odiv                     (**r [rd = r1 / r2] (signed) *)
| Odivu                    (**r [rd = r1 / r2] (unsigned) *)
| Omod                     (**r [rd = r1 % r2] (signed) *)
| Omodu                    (**r [rd = r1 % r2] (unsigned) *)
| Oand                     (**r [rd = r1 & r2] *)
| Oandimm (n: int)         (**r [rd = r1 & n] *)
| Oor                      (**r [rd = r1 | r2] *)
| Oorimm (n: int)          (**r [rd = r1 | n] *)
| Oxor                     (**r [rd = r1 ^ r2] *)
| Oxorimm (n: int)         (**r [rd = r1 ^ n] *)
| Onot                     (**r [rd = ~r1] *)
| Oshl                     (**r [rd = r1 << r2] *)
| Oshlimm (n: int)         (**r [rd = r1 << n] *)
| Oshr                     (**r [rd = r1 >> r2] (signed) *)
| Oshrimm (n: int)         (**r [rd = r1 >> n] (signed) *)
| Oshrximm (n: int)        (**r [rd = r1 / 2^n] (signed) *)
| Oshru                    (**r [rd = r1 >> r2] (unsigned) *)
| Oshruimm (n: int)        (**r [rd = r1 >> n] (unsigned) *)
| Ororimm (n: int)         (**r rotate right immediate *)
| Oshldimm (n: int)        (**r [rd = r1 << n | r2 >> (32-n)] *)
| Olea (a: addressing)     (**r effective address *)
(*c 64-bit integer arithmetic: *)
| Omakelong                (**r [rd = r1 << 32 | r2] *)
| Olowlong                 (**r [rd = low-word(r1)] *)
| Ohighlong                (**r [rd = high-word(r1)] *)
| Ocast32signed            (**r [rd] is 32-bit sign extension of [r1] *)
| Ocast32unsigned          (**r [rd] is 32-bit zero extension of [r1] *)
| Onegl                    (**r [rd = - r1] *)
| Oaddlimm (n: int64)      (**r [rd = r1 + n] *)
| Osubl                    (**r [rd = r1 - r2] *)
| Omull                    (**r [rd = r1 * r2] *)
| Omullimm (n: int64)      (**r [rd = r1 * n] *)
| Omullhs                  (**r [rd = high part of r1 * r2, signed] *)
| Omullhu                  (**r [rd = high part of r1 * r2, unsigned] *)
| Odivl                    (**r [rd = r1 / r2] (signed) *)
| Odivlu                   (**r [rd = r1 / r2] (unsigned) *)
| Omodl                    (**r [rd = r1 % r2] (signed) *)
| Omodlu                   (**r [rd = r1 % r2] (unsigned) *)
| Oandl                    (**r [rd = r1 & r2] *)
| Oandlimm (n: int64)      (**r [rd = r1 & n] *)
| Oorl                     (**r [rd = r1 | r2] *)
| Oorlimm (n: int64)       (**r [rd = r1 | n] *)
| Oxorl                    (**r [rd = r1 ^ r2] *)
| Oxorlimm (n: int64)      (**r [rd = r1 ^ n] *)
| Onotl                    (**r [rd = ~r1] *)
| Oshll                    (**r [rd = r1 << r2] *)
| Oshllimm (n: int)        (**r [rd = r1 << n] *)
| Oshrl                    (**r [rd = r1 >> r2] (signed) *)
| Oshrlimm (n: int)        (**r [rd = r1 >> n] (signed) *)
| Oshrxlimm (n: int)       (**r [rd = r1 / 2^n] (signed) *)
| Oshrlu                   (**r [rd = r1 >> r2] (unsigned) *)
| Oshrluimm (n: int)       (**r [rd = r1 >> n] (unsigned) *)
| Ororlimm (n: int)        (**r rotate right immediate *)
| Oleal (a: addressing)    (**r effective address *)
(*c Floating-point arithmetic: *)
| Onegf                    (**r [rd = - r1] *)
| Oabsf                    (**r [rd = abs(r1)] *)
| Oaddf                    (**r [rd = r1 + r2] *)
| Osubf                    (**r [rd = r1 - r2] *)
| Omulf                    (**r [rd = r1 * r2] *)
| Odivf                    (**r [rd = r1 / r2] *)
| Onegfs                   (**r [rd = - r1] *)
| Oabsfs                   (**r [rd = abs(r1)] *)
| Oaddfs                   (**r [rd = r1 + r2] *)
| Osubfs                   (**r [rd = r1 - r2] *)
| Omulfs                   (**r [rd = r1 * r2] *)
| Odivfs                   (**r [rd = r1 / r2] *)
| Osingleoffloat           (**r [rd] is [r1] truncated to single-precision float *)
| Ofloatofsingle           (**r [rd] is [r1] extended to double-precision float *)
(*c Conversions between int and float: *)
| Ointoffloat              (**r [rd = signed_int_of_float64(r1)] *)
| Ofloatofint              (**r [rd = float64_of_signed_int(r1)] *)
| Ointofsingle             (**r [rd = signed_int_of_float32(r1)] *)
| Osingleofint             (**r [rd = float32_of_signed_int(r1)] *)
| Olongoffloat             (**r [rd = signed_long_of_float64(r1)] *)
| Ofloatoflong             (**r [rd = float64_of_signed_long(r1)] *)
| Olongofsingle            (**r [rd = signed_long_of_float32(r1)] *)
| Osingleoflong            (**r [rd = float32_of_signed_long(r1)] *)
(*c Boolean tests: *)
| Ocmp (cond: condition).  (**r [rd = 1] if condition holds, [rd = 0] otherwise. *)
(** Comparison functions (used in modules [CSE] and [Allocation]). *)
Definition eq_condition (x y: condition) : {x=y} + {x<>y}.
Remark eval_addressing_Ainstack:
forall (F V: Type) (genv: Genv.t F V) sp ofs,
eval_addressing genv sp (Ainstack ofs) nil = Some (Val.offset_ptr sp ofs).
Remark eval_addressing_Ainstack_inv:
forall (F V: Type) (genv: Genv.t F V) sp ofs vl v,
eval_addressing genv sp (Ainstack ofs) vl = Some v -> vl = nil /\ v = Val.offset_ptr sp ofs.
Ltac FuncInv :=
match goal with
| H: (match ?x with nil => _ | _ :: _ => _ end = Some _) |- _ =>
destruct x; simpl in H; FuncInv
| H: (match ?v with Vundef => _ | Vint _ => _ | Vfloat _ => _ | Vptr _ _ => _ end = Some _) |- _ =>
destruct v; simpl in H; FuncInv
| H: (if Archi.ptr64 then _ else _) = Some _ |- _ =>
destruct Archi.ptr64 eqn:?; FuncInv
| H: (Some _ = Some _) |- _ =>
injection H; intros; clear H; FuncInv
| H: (None = Some _) |- _ =>
discriminate H
| _ =>
idtac
end.
(** * Static typing of conditions, operators and addressing modes. *)
Definition type_of_condition (c: condition) : list typ :=
match c with
| Ccomp _ => Tint :: Tint :: nil
| Ccompu _ => Tint :: Tint :: nil
| Ccompimm _ _ => Tint :: nil
| Ccompuimm _ _ => Tint :: nil
| Ccompl _ => Tlong :: Tlong :: nil
| Ccomplu _ => Tlong :: Tlong :: nil
| Ccomplimm _ _ => Tlong :: nil
| Ccompluimm _ _ => Tlong :: nil
| Ccompf _ => Tfloat :: Tfloat :: nil
| Cnotcompf _ => Tfloat :: Tfloat :: nil
| Ccompfs _ => Tsingle :: Tsingle :: nil
| Cnotcompfs _ => Tsingle :: Tsingle :: nil
| Cmaskzero _ => Tint :: nil
| Cmasknotzero _ => Tint :: nil
end.
Definition type_of_addressing_gen (tyA: typ) (addr: addressing): list typ :=
match addr with
| Aindexed _ => tyA :: nil
| Aindexed2 _ => tyA :: tyA :: nil
| Ascaled _ _ => tyA :: nil
| Aindexed2scaled _ _ => tyA :: tyA :: nil
| Aglobal _ _ => nil
| Abased _ _ => tyA :: nil
| Abasedscaled _ _ _ => tyA :: nil
| Ainstack _ => nil
end.
Definition type_of_addressing := type_of_addressing_gen Tptr.
Definition type_of_addressing32 := type_of_addressing_gen Tint.
Definition type_of_addressing64 := type_of_addressing_gen Tlong.
Definition type_of_operation (op: operation) : list typ * typ :=
match op with
| Omove => (nil, Tint)   (* treated specially *)
| Ointconst _ => (nil, Tint)
| Olongconst _ => (nil, Tlong)
| Ofloatconst f => (nil, Tfloat)
| Osingleconst f => (nil, Tsingle)
| Oindirectsymbol _ => (nil, Tptr)
| Ocast8signed => (Tint :: nil, Tint)
| Ocast8unsigned => (Tint :: nil, Tint)
| Ocast16signed => (Tint :: nil, Tint)
| Ocast16unsigned => (Tint :: nil, Tint)
| Oneg => (Tint :: nil, Tint)
| Osub => (Tint :: Tint :: nil, Tint)
| Omul => (Tint :: Tint :: nil, Tint)
| Omulimm _ => (Tint :: nil, Tint)
| Omulhs => (Tint :: Tint :: nil, Tint)
| Omulhu => (Tint :: Tint :: nil, Tint)
| Odiv => (Tint :: Tint :: nil, Tint)
| Odivu => (Tint :: Tint :: nil, Tint)
| Omod => (Tint :: Tint :: nil, Tint)
| Omodu => (Tint :: Tint :: nil, Tint)
| Oand => (Tint :: Tint :: nil, Tint)
| Oandimm _ => (Tint :: nil, Tint)
| Oor => (Tint :: Tint :: nil, Tint)
| Oorimm _ => (Tint :: nil, Tint)
| Oxor => (Tint :: Tint :: nil, Tint)
| Oxorimm _ => (Tint :: nil, Tint)
| Onot => (Tint :: nil, Tint)
| Oshl => (Tint :: Tint :: nil, Tint)
| Oshlimm _ => (Tint :: nil, Tint)
| Oshr => (Tint :: Tint :: nil, Tint)
| Oshrimm _ => (Tint :: nil, Tint)
| Oshrximm _ => (Tint :: nil, Tint)
| Oshru => (Tint :: Tint :: nil, Tint)
| Oshruimm _ => (Tint :: nil, Tint)
| Ororimm _ => (Tint :: nil, Tint)
| Oshldimm _ => (Tint :: Tint :: nil, Tint)
| Olea addr => (type_of_addressing32 addr, Tint)
| Omakelong => (Tint :: Tint :: nil, Tlong)
| Olowlong => (Tlong :: nil, Tint)
| Ohighlong => (Tlong :: nil, Tint)
| Ocast32signed => (Tint :: nil, Tlong)
| Ocast32unsigned => (Tint :: nil, Tlong)
| Onegl => (Tlong :: nil, Tlong)
| Oaddlimm _ => (Tlong :: nil, Tlong)
| Osubl => (Tlong :: Tlong :: nil, Tlong)
| Omull => (Tlong :: Tlong :: nil, Tlong)
| Omullimm _ => (Tlong :: nil, Tlong)
| Omullhs => (Tlong :: Tlong :: nil, Tlong)
| Omullhu => (Tlong :: Tlong :: nil, Tlong)
| Odivl => (Tlong :: Tlong :: nil, Tlong)
| Odivlu => (Tlong :: Tlong :: nil, Tlong)
| Omodl => (Tlong :: Tlong :: nil, Tlong)
| Omodlu => (Tlong :: Tlong :: nil, Tlong)
| Oandl => (Tlong :: Tlong :: nil, Tlong)
| Oandlimm _ => (Tlong :: nil, Tlong)
| Oorl => (Tlong :: Tlong :: nil, Tlong)
| Oorlimm _ => (Tlong :: nil, Tlong)
| Oxorl => (Tlong :: Tlong :: nil, Tlong)
| Oxorlimm _ => (Tlong :: nil, Tlong)
| Onotl => (Tlong :: nil, Tlong)
| Oshll => (Tlong :: Tint :: nil, Tlong)
| Oshllimm _ => (Tlong :: nil, Tlong)
| Oshrl => (Tlong :: Tint :: nil, Tlong)
| Oshrlimm _ => (Tlong :: nil, Tlong)
| Oshrxlimm _ => (Tlong :: nil, Tlong)
| Oshrlu => (Tlong :: Tint :: nil, Tlong)
| Oshrluimm _ => (Tlong :: nil, Tlong)
| Ororlimm _ => (Tlong :: nil, Tlong)
| Oleal addr => (type_of_addressing64 addr, Tlong)
| Onegf => (Tfloat :: nil, Tfloat)
| Oabsf => (Tfloat :: nil, Tfloat)
| Oaddf => (Tfloat :: Tfloat :: nil, Tfloat)
| Osubf => (Tfloat :: Tfloat :: nil, Tfloat)
| Omulf => (Tfloat :: Tfloat :: nil, Tfloat)
| Odivf => (Tfloat :: Tfloat :: nil, Tfloat)
| Onegfs => (Tsingle :: nil, Tsingle)
| Oabsfs => (Tsingle :: nil, Tsingle)
| Oaddfs => (Tsingle :: Tsingle :: nil, Tsingle)
| Osubfs => (Tsingle :: Tsingle :: nil, Tsingle)
| Omulfs => (Tsingle :: Tsingle :: nil, Tsingle)
| Odivfs => (Tsingle :: Tsingle :: nil, Tsingle)
| Osingleoffloat => (Tfloat :: nil, Tsingle)
| Ofloatofsingle => (Tsingle :: nil, Tfloat)
| Ointoffloat => (Tfloat :: nil, Tint)
| Ofloatofint => (Tint :: nil, Tfloat)
| Ointofsingle => (Tsingle :: nil, Tint)
| Osingleofint => (Tint :: nil, Tsingle)
| Olongoffloat => (Tfloat :: nil, Tlong)
| Ofloatoflong => (Tlong :: nil, Tfloat)
| Olongofsingle => (Tsingle :: nil, Tlong)
| Osingleoflong => (Tlong :: nil, Tsingle)
| Ocmp c => (type_of_condition c, Tint)
end.
(** Weak type soundness results for [eval_operation]: the result values, when defined, are always of the type predicted by [type_of_operation]. *)
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.

(* Specifications: *)
Lemma type_of_addressing64_sound:
forall addr vl sp v,
eval_addressing64 genv sp addr vl = Some v ->
Val.has_type v Tlong.
Lemma type_of_addressing32_sound:
forall addr vl sp v,
eval_addressing32 genv sp addr vl = Some v ->
Val.has_type v Tint.
Corollary type_of_addressing_sound:
forall addr vl sp v,
eval_addressing genv sp addr vl = Some v ->
Val.has_type v Tptr.
Lemma type_of_operation_sound:
forall op vl sp v m,
op <> Omove ->
eval_operation genv sp op vl m = Some v ->
Val.has_type v (snd (type_of_operation op)).