(* *********************************************************************)
(*                                                                     *)
(*              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 processor-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.
Local Transparent Archi.ptr64.
Record shift_amount: Type :=
{ s_amount: int;
s_range: Int.ltu s_amount Int.iwordsize = true }.
Coercion s_amount: shift_amount >-> int.
Inductive shift : Type :=
| Slsl: shift_amount -> shift
| Slsr: shift_amount -> shift
| Sasr: shift_amount -> shift
| Sror: shift_amount -> shift.
(** Conditions (boolean-valued operators). *)
Inductive condition : Type :=
| Ccomp: comparison -> condition  (**r signed integer comparison *)
| Ccompu: comparison -> condition (**r unsigned integer comparison *)
| Ccompshift: comparison -> shift -> condition  (**r signed integer comparison *)
| Ccompushift: comparison -> shift -> 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 64-bit floating-point comparison *)
| Cnotcompf: comparison -> condition (**r negation of a floating-point comparison *)
| Ccompfzero: comparison -> condition     (**r floating-point comparison with 0.0 *)
| Cnotcompfzero: comparison -> condition  (**r negation of a floating-point comparison with 0.0 *)
| Ccompfs: comparison -> condition    (**r 32-bit floating-point comparison *)
| Cnotcompfs: comparison -> condition (**r negation of a floating-point comparison *)
| Ccompfszero: comparison -> condition     (**r floating-point comparison with 0.0 *)
| Cnotcompfszero: comparison -> condition.  (**r negation of a floating-point comparison with 0.0 *)
(** 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 64-bit float constant *)
| Osingleconst: float32 -> operation  (**r [rd] is set to the given 32-bit 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] *)
| Oaddshift: shift -> operation       (**r [rd = r1 + shifted r2] *)
| Oaddimm: int -> operation           (**r [rd = r1 + n] *)
| Osub: operation                     (**r [rd = r1 - r2] *)
| Osubshift: shift -> operation       (**r [rd = r1 - shifted r2] *)
| Orsubshift: shift -> operation      (**r [rd = shifted r2 - r1] *)
| Orsubimm: int -> operation          (**r [rd = n - r1] *)
| Omul: operation                     (**r [rd = r1 * r2] *)
| Omla: operation                     (**r [rd = r1 * r2 + r3] *)
| 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] *)
| Oandshift: shift -> operation       (**r [rd = r1 & shifted r2] *)
| Oandimm: int -> operation           (**r [rd = r1 & n] *)
| Oor: operation                      (**r [rd = r1 | r2] *)
| Oorshift: shift -> operation        (**r [rd = r1 | shifted r2] *)
| Oorimm: int -> operation            (**r [rd = r1 | n] *)
| Oxor: operation                     (**r [rd = r1 ^ r2] *)
| Oxorshift: shift -> operation       (**r [rd = r1 ^ shifted r2] *)
| Oxorimm: int -> operation           (**r [rd = r1 ^ n] *)
| Obic: operation                     (**r [rd = r1 & ~r2] *)
| Obicshift: shift -> operation       (**r [rd = r1 & ~(shifted r2)] *)
| Onot: operation                     (**r [rd = ~r1] *)
| Onotshift: shift -> operation       (**r [rd = ~(shifted r1)] *)
| Oshl: operation                     (**r [rd = r1 << r2] *)
| Oshr: operation                     (**r [rd = r1 >> r2] (signed) *)
| Oshru: operation                    (**r [rd = r1 >> r2] (unsigned) *)
| Oshift: shift -> operation          (**r [rd = shifted r1] *)
| Oshrximm: int -> operation          (**r [rd = r1 / 2^n] (signed) *)
(*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] expanded 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)] *)
| Ofloatofint: operation              (**r [rd = float_of_signed_int(r1)] *)
| Ofloatofintu: operation             (**r [rd = float_of_unsigned_int(r1)] *)
| Ointofsingle: operation              (**r [rd = signed_int_of_single(r1)] *)
| Ointuofsingle: operation             (**r [rd = unsigned_int_of_single(r1)] *)
| Osingleofint: operation              (**r [rd = single_of_signed_int(r1)] *)
| Osingleofintu: operation             (**r [rd = single_of_unsigned_int(r1)] *)
(*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] *)
| Aindexed2shift: shift -> addressing (**r Address is [r1 + shifted r2] *)
| Ainstack: ptrofs -> addressing.        (**r Address is [stack_pointer + offset] *)
(** Comparison functions (used in module [CSE]). *)
Definition eq_shift (x y: shift): {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: (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
| Ccompshift _ _ => Tint :: Tint :: nil
| Ccompushift _ _ => Tint :: Tint :: nil
| Ccompimm _ _ => Tint :: nil
| Ccompuimm _ _ => Tint :: nil
| Ccompf _ => Tfloat :: Tfloat :: nil
| Cnotcompf _ => Tfloat :: Tfloat :: nil
| Ccompfzero _ => Tfloat :: nil
| Cnotcompfzero _ => Tfloat :: nil
| Ccompfs _ => Tsingle :: Tsingle :: nil
| Cnotcompfs _ => Tsingle :: Tsingle :: nil
| Ccompfszero _ => Tsingle :: nil
| Cnotcompfszero _ => Tsingle :: 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)
| Oaddshift _ => (Tint :: Tint :: nil, Tint)
| Oaddimm _ => (Tint :: nil, Tint)
| Osub => (Tint :: Tint :: nil, Tint)
| Osubshift _ => (Tint :: Tint :: nil, Tint)
| Orsubshift _ => (Tint :: Tint :: nil, Tint)
| Orsubimm _ => (Tint :: nil, Tint)
| Omul => (Tint :: Tint :: nil, Tint)
| Omla => (Tint :: Tint :: 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)
| Oandshift _ => (Tint :: Tint :: nil, Tint)
| Oandimm _ => (Tint :: nil, Tint)
| Oor => (Tint :: Tint :: nil, Tint)
| Oorshift _ => (Tint :: Tint :: nil, Tint)
| Oorimm _ => (Tint :: nil, Tint)
| Oxor => (Tint :: Tint :: nil, Tint)
| Oxorshift _ => (Tint :: Tint :: nil, Tint)
| Oxorimm _ => (Tint :: nil, Tint)
| Obic => (Tint :: Tint :: nil, Tint)
| Obicshift _ => (Tint :: Tint :: nil, Tint)
| Onot => (Tint :: nil, Tint)
| Onotshift _ => (Tint :: nil, Tint)
| Oshl => (Tint :: Tint :: nil, Tint)
| Oshr => (Tint :: Tint :: nil, Tint)
| Oshru => (Tint :: Tint :: nil, Tint)
| Oshift _ => (Tint :: nil, Tint)
| Oshrximm _ => (Tint :: nil, Tint)
| 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)
| Ointofsingle => (Tsingle :: nil, Tint)
| Ointuofsingle => (Tsingle :: nil, Tint)
| Osingleofint => (Tint :: nil, Tsingle)
| Osingleofintu => (Tint :: nil, Tsingle)
| 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
| Aindexed2shift _ => Tint :: 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.

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)).