(* *********************************************************************)
(*                                                                     *)
(*              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 PowerPC-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: comparison -> condition      (**r signed integer comparison *)
| Ccompu: comparison -> condition     (**r unsigned integer comparison *)
| Ccompimm: comparison -> int -> condition (**r signed integer comparison with a constant *)
| Ccompuimm: comparison -> int -> condition (**r unsigned integer comparison with a constant *)
| Ccompf: comparison -> condition     (**r floating-point comparison *)
| Cnotcompf: comparison -> condition  (**r negation of a floating-point comparison *)
| Cmaskzero: int -> condition         (**r test [(arg & constant) == 0] *)
| Cmasknotzero: int -> condition      (**r test [(arg & constant) != 0] *)
(*c PPC64 specific conditions: *)
| Ccompl: comparison -> condition     (**r signed int64 comparison *)
| Ccomplu: comparison -> condition    (**r unsigned int64 comparison *)
| Ccomplimm: comparison -> int64 -> condition (**r signed int64 comparison with a constant *)
| Ccompluimm: comparison -> int64 -> condition. (**r unsigned int64 comparison with a constant *)
(** 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: operation                    (**r [rd = r1] *)
| Ointconst: int -> operation         (**r [rd] is set to the given integer constant *)
| Ofloatconst: float -> operation     (**r [rd] is set to the given float constant *)
| Osingleconst: float32 -> operation  (**r [rd] is set to the given float constant *)
| Oaddrsymbol: ident -> ptrofs -> operation (**r [rd] is set to the the address of the symbol plus the offset *)
| Oaddrstack: ptrofs -> operation     (**r [rd] is set to the stack pointer plus the given offset *)
(*c Integer arithmetic: *)
| Ocast8signed: operation             (**r [rd] is 8-bit sign extension of [r1] *)
| Ocast16signed: operation            (**r [rd] is 16-bit sign extension of [r1] *)
| Oadd: operation                     (**r [rd = r1 + r2] *)
| Oaddimm: int -> operation           (**r [rd = r1 + n] *)
| Oaddsymbol: ident -> ptrofs -> operation (**r [rd = addr(id + ofs) + r1] *)
| Osub: operation                     (**r [rd = r1 - r2] *)
| Osubimm: int -> operation           (**r [rd = n - r1] *)
| Omul: operation                     (**r [rd = r1 * r2] *)
| Omulimm: int -> operation           (**r [rd = r1 * n] *)
| Omulhs: operation                   (**r [rd = high part of r1 * r2, signed] *)
| Omulhu: operation                   (**r [rd = high part of r1 * r2, unsigned] *)
| Odiv: operation                     (**r [rd = r1 / r2] (signed) *)
| Odivu: operation                    (**r [rd = r1 / r2] (unsigned) *)
| Oand: operation                     (**r [rd = r1 & r2] *)
| Oandimm: int -> operation           (**r [rd = r1 & n] *)
| Oor: operation                      (**r [rd = r1 | r2] *)
| Oorimm: int -> operation            (**r [rd = r1 | n] *)
| Oxor: operation                     (**r [rd = r1 ^ r2] *)
| Oxorimm: int -> operation           (**r [rd = r1 ^ n] *)
| Onot: operation                     (**r [rd = ~r1] *)
| Onand: operation                    (**r [rd = ~(r1 & r2)] *)
| Onor: operation                     (**r [rd = ~(r1 | r2)] *)
| Onxor: operation                    (**r [rd = ~(r1 ^ r2)] *)
| Oandc: operation                    (**r [rd = r1 & ~r2] *)
| Oorc: operation                     (**r [rd = r1 | ~r2] *)
| Oshl: operation                     (**r [rd = r1 << r2] *)
| Oshr: operation                     (**r [rd = r1 >> r2] (signed) *)
| Oshrimm: int -> operation           (**r [rd = r1 >> n] (signed) *)
| Oshrximm: int -> operation          (**r [rd = r1 / 2^n] (signed) *)
| Oshru: operation                    (**r [rd = r1 >> r2] (unsigned) *)
| Orolm: int -> int -> operation      (**r rotate left and mask *)
| Oroli: int -> int -> operation      (**r rotate left and insert *)
(*c PPC64 64-bit integer arithmetic: *)
| Olongconst: int64 -> operation      (**r [rd] is set to the given int64 constant *)
| Ocast32signed: operation            (**r [rd] is 64-bit sign extension of [r1] *)
| Ocast32unsigned: operation          (**r [rd] is 64-bit zero extension of [r1] *)
| Oaddl: operation                    (**r [rd = r1 + r2] *)
| Oaddlimm: int64 -> operation        (**r [rd = r1 + n] *)
| Osubl: operation                    (**r [rd = r1 - r2] *)
| Onegl: operation                    (**r [rd = - r1] *)
| Omull: operation                    (**r [rd = r1 * r2] *)
| Omullhs: operation                   (**r [rd = high part of r1 * r2, signed] *)
| Omullhu: operation                  (**r [rd = high part of r1 * r2, unsigned] *)
| Odivl: operation                    (**r [rd = r1 / r2] (signed) *)
| Odivlu: operation                   (**r [rd = r1 / r2] (unsigned) *)
| Oandl: operation                    (**r [rd = r1 & r2] *)
| Oandlimm: int64 -> operation        (**r [rd = r1 & n] *)
| Oorl: operation                     (**r [rd = r1 | r2] *)
| Oorlimm: int64 -> operation         (**r [rd = r1 | n] *)
| Oxorl: operation                    (**r [rd = r1 ^ r2] *)
| Oxorlimm: int64 -> operation        (**r [rd = r1 ^ n] *)
| Onotl: operation                    (**r [rd = ~r1] *)
| Oshll: operation                    (**r [rd = r1 << r2] *)
| Oshrl: operation                    (**r [rd = r1 >> r2] (signed) *)
| Oshrlimm: int -> operation          (**r [rd = r1 >> n] (signed) *)
| Oshrxlimm: int -> operation         (**r [rd = r1 / 2^n] (signed) *)
| Oshrlu: operation                   (**r [rd = r1 >> r2] (unsigned) *)
| Orolml: int -> int64 -> operation   (**r rotate left and mask *)
| Olongoffloat: operation             (**r [rd = signed_int64_of_float(r1)] *)
| Ofloatoflong: operation             (**r [rd = float_of_signed_int64(r1)] *)
(*c Floating-point arithmetic: *)
| Onegf: operation                    (**r [rd = - r1] *)
| Oabsf: operation                    (**r [rd = abs(r1)] *)
| Oaddf: operation                    (**r [rd = r1 + r2] *)
| Osubf: operation                    (**r [rd = r1 - r2] *)
| Omulf: operation                    (**r [rd = r1 * r2] *)
| Odivf: operation                    (**r [rd = r1 / r2] *)
| Onegfs: operation                   (**r [rd = - r1] *)
| Oabsfs: operation                   (**r [rd = abs(r1)] *)
| Oaddfs: operation                   (**r [rd = r1 + r2] *)
| Osubfs: operation                   (**r [rd = r1 - r2] *)
| Omulfs: operation                   (**r [rd = r1 * r2] *)
| Odivfs: operation                   (**r [rd = r1 / r2] *)
| Osingleoffloat: operation           (**r [rd] is [r1] truncated to single-precision float *)
| Ofloatofsingle: operation           (**r [rd] is [r1] extended to double-precision float *)
(*c Conversions between int and float: *)
| Ointoffloat: operation              (**r [rd = signed_int_of_float(r1)] *)
| Ointuoffloat: operation             (**r [rd = unsigned_int_of_float(r1)] (PPC64 only) *)
| Ofloatofint: operation              (**r [rd = float_of_signed_int(r1)] (PPC64 only) *)
| Ofloatofintu: operation             (**r [rd = float_of_unsigned_int(r1)] (PPC64 only *)
| Ofloatofwords: operation            (**r [rd = float_of_words(r1,r2)] *)
(*c Manipulating 64-bit integers: *)
| Omakelong: operation                (**r [rd = r1 << 32 | r2] *)
| Olowlong: operation                 (**r [rd = low-word(r1)] *)
| Ohighlong: operation                (**r [rd = high-word(r1)] *)
(*c Boolean tests: *)
| Ocmp: condition -> operation.       (**r [rd = 1] if condition holds, [rd = 0] otherwise. *)
(** Addressing modes.  [r1], [r2], etc, are the arguments to the addressing. *)
Inductive addressing: Type :=
| Aindexed: int -> addressing            (**r Address is [r1 + offset] *)
| Aindexed2: addressing                  (**r Address is [r1 + r2] *)
| Aglobal: ident -> ptrofs -> addressing (**r Address is [symbol + offset] *)
| Abased: ident -> ptrofs -> addressing  (**r Address is [symbol + offset + r1] *)
| Ainstack: ptrofs -> addressing.        (**r Address is [stack_pointer + offset] *)
(** Comparison functions (used in module [CSE]). *)
Definition eq_condition (x y: condition) : {x=y} + {x<>y}.
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; try discriminate; FuncInv
| H: (match ?v with Vundef => _ | Vint _ => _ | Vlong _ => _ | Vfloat _ => _ | Vptr _ _ => _ end = Some _) |- _ =>
destruct v; simpl in H; try discriminate; FuncInv
| H: (Some _ = Some _) |- _ =>
injection H; intros; clear H; FuncInv
| _ =>
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
| Ccompf _ => Tfloat :: Tfloat :: nil
| Cnotcompf _ => Tfloat :: Tfloat :: nil
| Cmaskzero _ => Tint :: nil
| Cmasknotzero _ => Tint :: nil
| Ccompl _ => Tlong :: Tlong :: nil
| Ccomplu _ => Tlong :: Tlong :: nil
| Ccomplimm _ _ => Tlong :: nil
| Ccompluimm _ _ => Tlong :: nil
end.
Definition type_of_operation (op: operation) : list typ * typ :=
match op with
| Omove => (nil, Tint)   (* treated specially *)
| Ointconst _ => (nil, Tint)
| Ofloatconst f => (nil, Tfloat)
| Osingleconst f => (nil, Tsingle)
| Oaddrsymbol _ _ => (nil, Tint)
| Oaddrstack _ => (nil, Tint)
| Ocast8signed => (Tint :: nil, Tint)
| Ocast16signed => (Tint :: nil, Tint)
| Oadd => (Tint :: Tint :: nil, Tint)
| Oaddimm _ => (Tint :: nil, Tint)
| Oaddsymbol _ _ => (Tint :: nil, Tint)
| Osub => (Tint :: Tint :: nil, Tint)
| Osubimm _ => (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)
| 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)
| Onand => (Tint :: Tint :: nil, Tint)
| Onor => (Tint :: Tint :: nil, Tint)
| Onxor => (Tint :: Tint :: nil, Tint)
| Oandc => (Tint :: Tint :: nil, Tint)
| Oorc => (Tint :: Tint :: nil, Tint)
| Oshl => (Tint :: Tint :: nil, Tint)
| Oshr => (Tint :: Tint :: nil, Tint)
| Oshrimm _ => (Tint :: nil, Tint)
| Oshrximm _ => (Tint :: nil, Tint)
| Oshru => (Tint :: Tint :: nil, Tint)
| Orolm _ _ => (Tint :: nil, Tint)
| Oroli _ _ => (Tint :: Tint :: nil, Tint)
| Olongconst _ => (nil, Tlong)
| Ocast32signed => (Tint :: nil, Tlong)
| Ocast32unsigned => (Tint :: nil, Tlong)
| Oaddl => (Tlong :: Tlong :: nil, Tlong)
| Oaddlimm _ => (Tlong :: nil, Tlong)
| Osubl => (Tlong :: Tlong :: nil, Tlong)
| Onegl => (Tlong :: nil, Tlong)
| Omull => (Tlong :: Tlong :: nil, Tlong)
| Omullhs => (Tlong :: Tlong :: nil, Tlong)
| Omullhu => (Tlong :: Tlong :: nil, Tlong)
| Odivl => (Tlong :: Tlong :: nil, Tlong)
| Odivlu => (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)
| Oshrl => (Tlong :: Tint :: nil, Tlong)
| Oshrlimm _ => (Tlong :: nil, Tlong)
| Oshrxlimm _ => (Tlong :: nil, Tlong)
| Oshrlu => (Tlong :: Tint :: nil, Tlong)
| Orolml _ _ => (Tlong :: nil, Tlong)
| Olongoffloat => (Tfloat :: nil, Tlong)
| Ofloatoflong => (Tlong :: nil, Tfloat)
| 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)
| Ointuoffloat => (Tfloat :: nil, Tint)
| Ofloatofint => (Tint :: nil, Tfloat)
| Ofloatofintu => (Tint :: nil, Tfloat)
| Ofloatofwords => (Tint :: Tint :: nil, Tfloat)
| Omakelong => (Tint :: Tint :: nil, Tlong)
| Olowlong => (Tlong :: nil, Tint)
| Ohighlong => (Tlong :: nil, Tint)
| Ocmp c => (type_of_condition c, Tint)
end.
Definition type_of_addressing (addr: addressing) : list typ :=
match addr with
| Aindexed _ => Tint :: nil
| Aindexed2 => Tint :: Tint :: nil
| Aglobal _ _ => nil
| Abased _ _ => Tint :: nil
| Ainstack _ => nil
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.

(* Specifications: *)
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)).