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

Lemma shrimm_sound:
forall v w x n,
vagree v w (shrimm x n) ->
vagree (Val.shr v (Vint n)) (Val.shr w (Vint n)) x.