(* *********************************************************************)
(*                                                                     *)
(*              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.     *)
(*                                                                     *)
(* *********************************************************************)
(** Abstract domain for neededness analysis *)
(** * Neededness for values *)
Inductive nval : Type :=
| Nothing              (**r value is entirely unused *)
| I (m: int)           (**r only need the bits that are 1 in [m] *)
| All.                 (**r every bit of the value is used *)
Definition eq_nval (x y: nval) : {x=y} + {x<>y}.
Hint Resolve vagree_same vagree_lessdef lessdef_vagree: na.
Inductive vagree_list: list val -> list val -> list nval -> Prop :=
| vagree_list_nil: forall nvl,
vagree_list nil nil nvl
| vagree_list_default: forall v1 vl1 v2 vl2,
vagree v1 v2 All -> vagree_list vl1 vl2 nil ->
vagree_list (v1 :: vl1) (v2 :: vl2) nil
| vagree_list_cons: forall v1 vl1 v2 vl2 nv1 nvl,
vagree v1 v2 nv1 -> vagree_list vl1 vl2 nvl ->
vagree_list (v1 :: vl1) (v2 :: vl2) (nv1 :: nvl).
Hint Resolve lessdef_vagree_list vagree_lessdef_list: na.
(** ** Ordering and least upper bound between value needs *)
Inductive nge: nval -> nval -> Prop :=
| nge_nothing: forall x, nge All x
| nge_all: forall x, nge x Nothing
| nge_int: forall m1 m2,
(forall i, 0 <= i < Int.zwordsize -> Int.testbit m2 i = true -> Int.testbit m1 i = true) ->
nge (I m1) (I m2).
Hint Constructors nge: na.
Hint Resolve nge_refl: na.
Definition nlub (x y: nval) : nval :=
match x, y with
| Nothing, _ => y
| _, Nothing => x
| I m1, I m2 => I (Int.or m1 m2)
| _, _ => All
end.
(** ** Properties of agreement between integers *)
Remark eq_same_bits:
forall i x y, x = y -> Int.testbit x i = Int.testbit y i.
Definition complete_mask (m: int) := Int.zero_ext (Int.size m) Int.mone.
(** ** Abstract operations over value needs. *)
Ltac InvAgree :=
simpl vagree in *;
repeat (
auto || exact Logic.I ||
match goal with
| [ H: False |- _ ] => contradiction
| [ H: match ?v with Vundef => _ | Vint _ => _ | Vlong _ => _ | Vfloat _ => _ | Vsingle _ => _ | Vptr _ _ => _ end |- _ ] => destruct v
| [ |- context [if Archi.ptr64 then _ else _] ] => destruct Archi.ptr64 eqn:?
end).
(** And immediate, or immediate *)
Definition andimm (x: nval) (n: int) :=
match x with
| Nothing => Nothing
| I m => I (Int.and m n)
| All => I n
end.
Definition orimm (x: nval) (n: int) :=
match x with
| Nothing => Nothing
| I m => I (Int.and m (Int.not n))
| _ => I (Int.not n)
end.
(** Bitwise operations: and, or, xor, not *)
Definition bitwise (x: nval) := x.
Remark bitwise_idem: forall nv, bitwise (bitwise nv) = bitwise nv.
Proof (vagree_bitwise_binop Int.and (iagree_bitwise_binop andb Int.and Int.bits_and)).
Proof (vagree_bitwise_binop Int.or (iagree_bitwise_binop orb Int.or Int.bits_or)).
Proof (vagree_bitwise_binop Int.xor (iagree_bitwise_binop xorb Int.xor Int.bits_xor)).
(** Shifts and rotates *)
Definition shlimm (x: nval) (n: int) :=
match x with
| Nothing => Nothing
| I m => I (Int.shru m n)
| All => I (Int.shru Int.mone n)
end.
Definition shruimm (x: nval) (n: int) :=
match x with
| Nothing => Nothing
| I m => I (Int.shl m n)
| All => I (Int.shl Int.mone n)
end.
Definition shrimm (x: nval) (n: int) :=
match x with
| Nothing => Nothing
| I m => I (let m' := Int.shl m n in
if Int.eq_dec (Int.shru m' n) m
then m'
else Int.or m' (Int.repr Int.min_signed))
| All => I (Int.or (Int.shl Int.mone n) (Int.repr Int.min_signed))
end.
Definition rol (x: nval) (amount: int) :=
match x with
| Nothing => Nothing
| I m => I (Int.ror m amount)
| All => All
end.
Definition ror (x: nval) (amount: int) :=
match x with
| Nothing => Nothing
| I m => I (Int.rol m amount)
| All => All
end.
Definition rolm (x: nval) (amount mask: int) := rol (andimm x mask) amount.
(** Modular arithmetic operations: add, mul, opposite. Also subtraction, but only on 64-bit targets, otherwise the pointer - pointer case does not fit. *)
Definition modarith (x: nval) :=
match x with
| Nothing => Nothing
| I m => I (complete_mask m)
| All => All
end.
Remark modarith_idem: forall nv, modarith (modarith nv) = modarith nv.
(** Conversions: zero extension, sign extension, single-of-float *)
Definition zero_ext (n: Z) (x: nval) :=
match x with
| Nothing => Nothing
| I m => I (Int.zero_ext n m)
| All => I (Int.zero_ext n Int.mone)
end.
Definition sign_ext (n: Z) (x: nval) :=
match x with
| Nothing => Nothing
| I m => I (Int.or (Int.zero_ext n m) (Int.shl Int.one (Int.repr (n - 1))))
| All => I (Int.zero_ext n Int.mone)
end.
(** The needs of a memory store concerning the value being stored. *)
Definition store_argument (chunk: memory_chunk) :=
match chunk with
| Mint8signed | Mint8unsigned => I (Int.repr 255)
| Mint16signed | Mint16unsigned => I (Int.repr 65535)
| _ => All
end.
(** The needs of a comparison *)
Definition maskzero (n: int) := I n.
(** The needs of a select *)

Lemma select_sound:
forall ob v1 v2 w1 w2 ty x,
vagree v1 w1 x -> vagree v2 w2 x ->
vagree (Val.select ob v1 v2 ty) (Val.select ob w1 w2 ty) x.