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

(** Static analysis and strength reduction for operators 
  and conditions.  This is the machine-dependent part of [Constprop]. *)

Require Import Coqlib.
Require Import Compopts.
Require Import AST.
Require Import Integers.
Require Import Floats.
Require Import Op.
Require Import Registers.
Require Import ValueDomain.

(** * Operator strength reduction *)

(** We now define auxiliary functions for strength reduction of
  operators and addressing modes: replacing an operator with a cheaper
  one if some of its arguments are statically known.  These are again
  large pattern-matchings expressed in indirect style. *)

Section STRENGTH_REDUCTION.

Definition eval_static_shift (s: shift) (n: int) : int :=
  match s with
  | Slsl x => Int.shl n x
  | Slsr x => Int.shru n x
  | Sasr x => Int.shr n x
  | Sror x => Int.ror n x
  end.

Nondetfunction cond_strength_reduction 
              (cond: condition) (args: list reg) (vl: list aval) :=
  match cond, args, vl with
  | Ccomp c, r1 :: r2 :: nil, I n1 :: v2 :: nil =>
      (Ccompimm (swap_comparison c) n1, r2 :: nil)
  | Ccomp c, r1 :: r2 :: nil, v1 :: I n2 :: nil =>
      (Ccompimm c n2, r1 :: nil)
  | Ccompu c, r1 :: r2 :: nil, I n1 :: v2 :: nil =>
      (Ccompuimm (swap_comparison c) n1, r2 :: nil)
  | Ccompu c, r1 :: r2 :: nil, v1 :: I n2 :: nil =>
      (Ccompuimm c n2, r1 :: nil)
  | Ccompshift c s, r1 :: r2 :: nil, v1 :: I n2 :: nil =>
      (Ccompimm c (eval_static_shift s n2), r1 :: nil)
  | Ccompushift c s, r1 :: r2 :: nil, v1 :: I n2 :: nil =>
      (Ccompuimm c (eval_static_shift s n2), r1 :: nil)
  | Ccompf c, r1 :: r2 :: nil, F n1 :: v2 :: nil =>
      if Float.eq_dec n1 Float.zero
      then (Ccompfzero (swap_comparison c), r2 :: nil)
      else (cond, args)
  | Ccompf c, r1 :: r2 :: nil, v1 :: F n2 :: nil =>
      if Float.eq_dec n2 Float.zero
      then (Ccompfzero c, r1 :: nil)
      else (cond, args)
  | Cnotcompf c, r1 :: r2 :: nil, F n1 :: v2 :: nil =>
      if Float.eq_dec n1 Float.zero
      then (Cnotcompfzero (swap_comparison c), r2 :: nil)
      else (cond, args)
  | Cnotcompf c, r1 :: r2 :: nil, v1 :: F n2 :: nil =>
      if Float.eq_dec n2 Float.zero
      then (Cnotcompfzero c, r1 :: nil)
      else (cond, args)
  | Ccompfs c, r1 :: r2 :: nil, FS n1 :: v2 :: nil =>
      if Float32.eq_dec n1 Float32.zero
      then (Ccompfszero (swap_comparison c), r2 :: nil)
      else (cond, args)
  | Ccompfs c, r1 :: r2 :: nil, v1 :: FS n2 :: nil =>
      if Float32.eq_dec n2 Float32.zero
      then (Ccompfszero c, r1 :: nil)
      else (cond, args)
  | Cnotcompfs c, r1 :: r2 :: nil, FS n1 :: v2 :: nil =>
      if Float32.eq_dec n1 Float32.zero
      then (Cnotcompfszero (swap_comparison c), r2 :: nil)
      else (cond, args)
  | Cnotcompfs c, r1 :: r2 :: nil, v1 :: FS n2 :: nil =>
      if Float32.eq_dec n2 Float32.zero
      then (Cnotcompfszero c, r1 :: nil)
      else (cond, args)
  | _, _, _ => 
      (cond, args)
  end.

Definition make_cmp_base (c: condition) (args: list reg) (vl: list aval) :=
  let (c', args') := cond_strength_reduction c args vl in (Ocmp c', args').

Nondetfunction make_cmp (c: condition) (args: list reg) (vl: list aval) :=
  match c, args, vl with
  | Ccompimm Ceq n, r1 :: nil, v1 :: nil =>
      if Int.eq_dec n Int.one && vincl v1 (Uns 1) then (Omove, r1 :: nil)
      else if Int.eq_dec n Int.zero && vincl v1 (Uns 1) then (Oxorimm Int.one, r1 :: nil)
      else make_cmp_base c args vl
  | Ccompimm Cne n, r1 :: nil, v1 :: nil =>
      if Int.eq_dec n Int.zero && vincl v1 (Uns 1) then (Omove, r1 :: nil)
      else if Int.eq_dec n Int.one && vincl v1 (Uns 1) then (Oxorimm Int.one, r1 :: nil)
      else make_cmp_base c args vl
  | _, _, _ =>
      make_cmp_base c args vl
  end.

Definition make_addimm (n: int) (r: reg) :=
  if Int.eq n Int.zero
  then (Omove, r :: nil)
  else (Oaddimm n, r :: nil).

Definition make_shlimm (n: int) (r1 r2: reg) :=
  if Int.eq n Int.zero then
    (Omove, r1 :: nil)
  else if Int.ltu n Int.iwordsize then
    (Oshift (Slsl (mk_shift_amount n)), r1 :: nil)
  else
    (Oshl, r1 :: r2 :: nil).

Definition make_shrimm (n: int) (r1 r2: reg) :=
  if Int.eq n Int.zero then
    (Omove, r1 :: nil)
  else if Int.ltu n Int.iwordsize then
    (Oshift (Sasr (mk_shift_amount n)), r1 :: nil)
  else
    (Oshr, r1 :: r2 :: nil).

Definition make_shruimm (n: int) (r1 r2: reg) :=
  if Int.eq n Int.zero then
    (Omove, r1 :: nil)
  else if Int.ltu n Int.iwordsize then
    (Oshift (Slsr (mk_shift_amount n)), r1 :: nil)
  else
    (Oshru, r1 :: r2 :: nil).

Definition make_mulimm (n: int) (r1 r2: reg) :=
  if Int.eq n Int.zero then
    (Ointconst Int.zero, nil)
  else if Int.eq n Int.one then
    (Omove, r1 :: nil)
  else
    match Int.is_power2 n with
    | Some l => (Oshift (Slsl (mk_shift_amount l)), r1 :: nil)
    | None => (Omul, r1 :: r2 :: nil)
    end.

Definition make_divimm (n: int) (r1 r2: reg) :=
  match Int.is_power2 n with
  | Some l => if Int.ltu l (Int.repr 31)
              then (Oshrximm l, r1 :: nil)
              else (Odiv, r1 :: r2 :: nil)
  | None   => (Odiv, r1 :: r2 :: nil)
  end.

Definition make_divuimm (n: int) (r1 r2: reg) :=
  match Int.is_power2 n with
  | Some l => (Oshift (Slsr (mk_shift_amount l)), r1 :: nil)
  | None   => (Odivu, r1 :: r2 :: nil)
  end.

Definition make_andimm (n: int) (r: reg) (a: aval) :=
  if Int.eq n Int.zero then (Ointconst Int.zero, nil)
  else if Int.eq n Int.mone then (Omove, r :: nil)
  else if match a with Uns m => Int.eq (Int.zero_ext m (Int.not n)) Int.zero
                     | _ => false end
  then (Omove, r :: nil)
  else (Oandimm n, r :: nil).

Definition make_orimm (n: int) (r: reg) :=
  if Int.eq n Int.zero then (Omove, r :: nil)
  else if Int.eq n Int.mone then (Ointconst Int.mone, nil)
  else (Oorimm n, r :: nil).

Definition make_xorimm (n: int) (r: reg) :=
  if Int.eq n Int.zero then (Omove, r :: nil)
  else if Int.eq n Int.mone then (Onot, r :: nil)
  else (Oxorimm n, r :: nil).

Definition make_mulfimm (n: float) (r r1 r2: reg) :=
  if Float.eq_dec n (Float.of_int (Int.repr 2))
  then (Oaddf, r :: r :: nil)
  else (Omulf, r1 :: r2 :: nil).

Definition make_mulfsimm (n: float32) (r r1 r2: reg) :=
  if Float32.eq_dec n (Float32.of_int (Int.repr 2))
  then (Oaddfs, r :: r :: nil)
  else (Omulfs, r1 :: r2 :: nil).

Definition make_cast8signed (r: reg) (a: aval) :=
  if vincl a (Sgn 8) then (Omove, r :: nil) else (Ocast8signed, r :: nil).
Definition make_cast16signed (r: reg) (a: aval) :=
  if vincl a (Sgn 16) then (Omove, r :: nil) else (Ocast16signed, r :: nil).

Nondetfunction op_strength_reduction 
              (op: operation) (args: list reg) (vl: list aval) :=
  match op, args, vl with
  | Ocast8signed, r1 :: nil, v1 :: nil => make_cast8signed r1 v1
  | Ocast16signed, r1 :: nil, v1 :: nil => make_cast16signed r1 v1
  | Oadd, r1 :: r2 :: nil, I n1 :: v2 :: nil => make_addimm n1 r2
  | Oadd, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_addimm n2 r1
  | Oaddshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_addimm (eval_static_shift s n2) r1
  | Osub, r1 :: r2 :: nil, I n1 :: v2 :: nil => (Orsubimm n1, r2 :: nil)
  | Osub, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_addimm (Int.neg n2) r1
  | Osubshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_addimm (Int.neg (eval_static_shift s n2)) r1
  | Orsubshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => (Orsubimm (eval_static_shift s n2), r1 :: nil)
  | Omul, r1 :: r2 :: nil, I n1 :: v2 :: nil => make_mulimm n1 r2 r1
  | Omul, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_mulimm n2 r1 r2
  | Odiv, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_divimm n2 r1 r2
  | Odivu, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_divuimm n2 r1 r2
  | Oand, r1 :: r2 :: nil, I n1 :: v2 :: nil => make_andimm n1 r2 v2
  | Oand, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_andimm n2 r1 v1
  | Oandshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_andimm (eval_static_shift s n2) r1 v1
  | Oor, r1 :: r2 :: nil, I n1 :: v2 :: nil => make_orimm n1 r2
  | Oor, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_orimm n2 r1
  | Oorshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_orimm (eval_static_shift s n2) r1
  | Oxor, r1 :: r2 :: nil, I n1 :: v2 :: nil => make_xorimm n1 r2
  | Oxor, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_xorimm n2 r1
  | Oxorshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_xorimm (eval_static_shift s n2) r1
  | Obic, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_andimm (Int.not n2) r1 v1
  | Obicshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_andimm (Int.not (eval_static_shift s n2)) r1 v1
  | Oshl, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shlimm n2 r1 r2
  | Oshr, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shrimm n2 r1 r2
  | Oshru, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shruimm n2 r1 r2
  | Ocmp c, args, vl => make_cmp c args vl
  | Omulf, r1 :: r2 :: nil, v1 :: F n2 :: nil => make_mulfimm n2 r1 r1 r2
  | Omulf, r1 :: r2 :: nil, F n1 :: v2 :: nil => make_mulfimm n1 r2 r1 r2
  | Omulfs, r1 :: r2 :: nil, v1 :: FS n2 :: nil => make_mulfsimm n2 r1 r1 r2
  | Omulfs, r1 :: r2 :: nil, FS n1 :: v2 :: nil => make_mulfsimm n1 r2 r1 r2
  | _, _, _ => (op, args)
  end.


Nondetfunction addr_strength_reduction
                (addr: addressing) (args: list reg) (vl: list aval) :=
  match addr, args, vl with
  | Aindexed2, r1 :: r2 :: nil, Ptr(Stk n1) :: I n2 :: nil =>
      (Ainstack (Int.add n1 n2), nil)
  | Aindexed2, r1 :: r2 :: nil, I n1 :: Ptr(Stk n2) :: nil =>
      (Ainstack (Int.add n1 n2), nil)
  | Aindexed2, r1 :: r2 :: nil, I n1 :: v2 :: nil =>
      (Aindexed n1, r2 :: nil)
  | Aindexed2, r1 :: r2 :: nil, v1 :: I n2 :: nil =>
      (Aindexed n2, r1 :: nil)
  | Aindexed2shift s, r1 :: r2 :: nil, Ptr(Stk n1) :: I n2 :: nil =>
      (Ainstack (Int.add n1 (eval_static_shift s n2)), nil)
  | Aindexed2shift s, r1 :: r2 :: nil, v1 :: I n2 :: nil =>
      (Aindexed (eval_static_shift s n2), r1 :: nil)
  | Aindexed n, r1 :: nil, Ptr(Stk n1) :: nil =>
      (Ainstack (Int.add n1 n), nil)
  | _, _, _ =>
      (addr, args)
  end.

End STRENGTH_REDUCTION.