(*
 * Copyright (c) 2000-2002 Stefan Kral
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *
 *)

(* This module declares basics data-types for virtual simd instructions
 * and defines some frequently used functions on them.
 *)

open List
open Util
open Number
open Variable
open VFpBasics


type vsimdreg = V_SimdReg of int	(* VIRTUAL SIMD REGISTER ************)

let makeNewVsimdreg = 
  let vsimdreg_counter = ref 1000 in		(* avoid starting with 0 *)
  fun () ->
    let retval = !vsimdreg_counter in
      incr vsimdreg_counter;
      V_SimdReg retval

module VSimdRegSet = Set.Make(struct type t = vsimdreg let compare = compare end)

module VSimdRegMap = Map.Make(struct type t = vsimdreg let compare = compare end)
let vsimdregmap_find k m = try Some(VSimdRegMap.find k m) with Not_found -> None

let vsimdregmap_findE k m = try VSimdRegMap.find k m with Not_found -> []
let vsimdregmap_addE k v m = VSimdRegMap.add k (v::(vsimdregmap_findE k m)) m
let vsimdregmap_addE' value key map = vsimdregmap_addE key value map
let vsimdregmap_cutE k m = VSimdRegMap.add k (tl (VSimdRegMap.find k m)) m

(****************************************************************************)

type vsign = V_Pos | V_Neg					    (* SIGN *)
type vsimdchspos = V_ChsLo | V_ChsHi | V_ChsLoHi (* WHERE 2 CHANGE THE SIGN *)
type vsimdpos = V_Lo | V_Hi		(* POSITION WITHIN A SIMD WORD ******)
type realimag = RealPart | ImagPart	(* COMPONENT OF A COMPLEX NUMBER ****)

let vsimdchsposToConstants = function
  | V_ChsLo   -> (Number.mone, Number.one)
  | V_ChsHi   -> (Number.one,  Number.mone)
  | V_ChsLoHi -> (Number.mone, Number.mone)

(****************************************************************************)

type vsimdinstroperand = 		 (* VIRTUAL SIMD INSTR OPERAND ******)
  | V_SimdTmp of int			 (*   Simd Temporary Variable  [id] *)
  | V_SimdDVar of vfpaccess * array * int (*   Simd DWord Var      [arr,idx] *)
  | V_SimdQVar of array * int		 (*   Simd QWord Var      [arr,idx] *)
  | V_SimdNConst of string 		 (*   Named Const	 [name_str] *)
  | V_SimdNumConst of float * float  	 (*   Numeric Constant	[c_lo,c_hi] *)

module VSimdInstrOperandSet = Set.Make(struct 
					 type t = vsimdinstroperand 
					 let compare = compare 
				       end)

type vsimdrawvar = 			(* RAW SIMD VARIABLE (w/o Array) ****)
  | V_SimdRawQVar of int
  | V_SimdRawDVar of vfpaccess * int

module VSimdRawVarSet = Set.Make(struct 
				   type t = vsimdrawvar 
				   let compare = compare 
				 end)

(* Returns true if assignment of a clobbers variable b.  Do not mix
 * SimdQVars and SimdDVar (-> possible undetected aliasing conflict). *)
(*
function should work, but is no longer in use.

let vsimdinstroperand_clobbers a b = match (a,b) with
  | V_SimdQVar(Output,k1),   V_SimdQVar(Input,k2) -> k1=k2
  | V_SimdDVar(p,Output,k1), V_SimdDVar(q,Input,k2) -> k1=k2 && p=q
  | _ -> false
*)

let vsimdinstroperand_is_temporary = function 
  | V_SimdTmp _ -> true 
  | _		-> false

let vsimdinstroperand_is_twiddle = function
  | V_SimdQVar(Twiddle,_)   -> true
  | V_SimdDVar(_,Twiddle,_) -> true
  | _ 			    -> false

(****************************************************************************)

type vsimdternaryop = 			(* SIMD TERNARY OPERATION ***********)
  | V_FMA2				(*   Parallel Fused Multiply-Add    *)
  | V_FMS2				(*   Parallel Fused Multiply-Sub    *)

type vsimdbinaryop =			(* SIMD BINARY OPERATION ************)
  | V_Add2				(*   Parallel Addition		    *)
  | V_Sub2				(*   Parallel Subtraction	    *)
  | V_Mul2				(*   Parallel Multiplication	    *)
  | V_Acc2 of vsign * vsign		(*   Intraoperand Accumulate 	    *)
  | V_FNMcA2 of number * number		(*   Parallel Neg Mul w/Const-Add   *)
  | V_FMcA2 of number * number		(*   Parallel Fused Mul w/Const-Add *)
  | V_FMcS2 of number * number		(*   Parallel Fused Mul w/Const-Sub *)
  | V_UnpackL
  | V_UnpackH
  | V_UnpackLH

type vsimdunaryop =			(* SIMD UNARY OPERATION *************)
  | V_Id				(*   Copy Content		    *)
  | V_Swap				(*   Flip Lo/Hi Part of 2-way Reg   *)
  | V_SwapChsL				(*   XXX *)
  | V_SwapChsH				(*   XXX *)
  | V_Chs of vsimdchspos 		(*   Negate Part of Simd Register   *)
  | V_MulConst of number * number	(*   Multiply with 2-way Constant   *)

let eq_vsimdunaryop a b = match (a,b) with
  | (V_Id, V_Id) -> true
  | (V_Swap, V_Swap) -> true
  | (V_SwapChsL, V_SwapChsL) -> true
  | (V_SwapChsH, V_SwapChsH) -> true
  | (V_Chs p1, V_Chs p2) -> p1=p2
  | (V_MulConst(n,m), V_MulConst(n',m')) -> eq_number n n' && eq_number m m'
  | _ -> false

let eq_vsimdbinaryop a b = match (a,b) with
  | (V_Add2,V_Add2) -> true
  | (V_Sub2,V_Sub2) -> true
  | (V_Mul2,V_Mul2) -> true
  | (V_Acc2(a,b),V_Acc2(a',b')) -> a'=a && b'=b
  | (V_UnpackL,V_UnpackL) -> true
  | (V_UnpackH,V_UnpackH) -> true
  | (V_UnpackLH,V_UnpackLH) -> true
  | (V_FNMcA2(a,b),V_FNMcA2(a',b')) -> eq_number a a' && eq_number b b'
  | (V_FMcA2(a,b), V_FMcA2(a',b')) -> eq_number a a' && eq_number b b'
  | (V_FMcS2(a,b), V_FMcS2(a',b')) -> eq_number a a' && eq_number b b'
  | _ -> false

let vsimdbinopIsParallel = function	(* inter-operand parallel binary-op *)
  | V_Add2     -> true
  | V_Sub2     -> true
  | V_Mul2     -> true
  | V_FNMcA2 _ -> false			(* (because of the constants) *)
  | V_FMcA2 _  -> false			(* (because of the constants) *)
  | V_FMcS2 _  -> false			(* (because of the constants) *)
  | V_UnpackL  -> false
  | V_UnpackH  -> false
  | V_UnpackLH -> false
  | V_Acc2 _   -> false

(****************************************************************************)

type vsimdinstr = 			(* VIRTUAL SIMD INSTRUCTION *********)
  | V_SimdLoad2 of 			(*   Load SIMD Quadword:	    *)
	array * 			(*	= source array (s_array)    *)
	int * 				(*      = src element index (s_idx) *)
	vsimdreg			(*	= dst simd register (d_reg) *)
  | V_SimdStore2 of 			(*   Store SIMD Quadword:	    *)
	vsimdreg *			(*	= src simd register (s_reg) *)
	array * 			(*	= dst array (d_array)	    *)
	int				(*	= dst element index (d_idx) *)
  | V_SimdUnaryOp of 			(*   Do 2-Way Unary Operation:      *)
	vsimdunaryop *			(*	= operation id (unary_op)   *)
	vsimdreg *			(*	= source register (s_reg)   *)
	vsimdreg			(*	= dest register (d_reg)     *)
  | V_SimdBinaryOp of 			(*   Do 2-Way Binary Operation:     *)
	vsimdbinaryop *			(*	= operation id (binary_op)  *)
	vsimdreg * 			(*	= source reg #1 (s1_reg)    *)
	vsimdreg *			(*	= source reg #2 (s2_reg)    *)
	vsimdreg			(*	= dest register (d_reg)     *)
  | V_SimdTernaryOp of 			(*   Do 2-Way Ternary Operation:    *)
	vsimdternaryop *		(*	= operation id (tern_op)    *)
	vsimdreg *			(*	= source reg #1 (s1_reg)    *)
	vsimdreg * 			(*	= source reg #2 (s2_reg)    *)
	vsimdreg *			(*	= source reg #3 (s3_reg)    *)
	vsimdreg			(*	= dest register (d_reg)     *)

(* Output list does not contain any duplicates. *)
let vsimdinstrToSrcregs = function
  | V_SimdLoad2 _	          -> []
  | V_SimdStore2(s,_,_)           -> [s]
  | V_SimdTernaryOp(_,s1,s2,s3,_) -> uniq [s1;s2;s3]
  | V_SimdBinaryOp(_,s1,s2,_)     -> uniq [s1;s2]
  | V_SimdUnaryOp(_,s,_)          -> [s]

let vsimdinstrToDstreg = function
  | V_SimdStore2 _             -> None
  | V_SimdLoad2(_,_,d)         -> Some d
  | V_SimdTernaryOp(_,_,_,_,d) -> Some d
  | V_SimdBinaryOp(_,_,_,d)    -> Some d
  | V_SimdUnaryOp(_,_,d)       -> Some d

let vsimdinstrToReads  instr = vsimdinstrToSrcregs instr
let vsimdinstrToWrites instr = optionToList (vsimdinstrToDstreg instr) 
let vsimdinstrToReadswritespair i = (vsimdinstrToReads i,vsimdinstrToWrites i)

let vsimdinstrIsLoad = function
  | V_SimdLoad2 _    -> true
  | V_SimdStore2 _   -> false
  | V_SimdTernaryOp _   -> false
  | V_SimdBinaryOp _    -> false
  | V_SimdUnaryOp _  -> false

let vsimdinstrIsStore = function
  | V_SimdLoad2 _    -> false
  | V_SimdStore2 _   -> true
  | V_SimdTernaryOp _   -> false
  | V_SimdBinaryOp _    -> false
  | V_SimdUnaryOp _  -> false

let vsimdchsposToSwapped = function
  | V_ChsLo   -> V_ChsHi
  | V_ChsHi   -> V_ChsLo
  | V_ChsLoHi -> V_ChsLoHi

(****************************************************************************)

let vsimdchsposToSrcoperand = function
  | V_ChsLo   -> V_SimdNConst "chsl"
  | V_ChsHi   -> V_SimdNConst "chsh"
  | V_ChsLoHi -> V_SimdNConst "chslh"

let vsimdunaryopToSrcoperands = function
  | V_MulConst(n,m) -> [V_SimdNumConst(numberToFloat n, numberToFloat m)]
  | V_Chs p	    -> [vsimdchsposToSrcoperand p]
  | V_Id	    -> []
  | V_Swap	    -> []
  | V_SwapChsL	    -> []
  | V_SwapChsH	    -> []

let vsimdinstrToSrcoperands = function
  | V_SimdLoad2(arr,el,_) 	      -> [V_SimdQVar(arr,el)]
  | V_SimdStore2(V_SimdReg s,_,_)     -> [V_SimdTmp s]
  | V_SimdUnaryOp(op,V_SimdReg s,_) -> 
      (V_SimdTmp s)::(vsimdunaryopToSrcoperands op)
  | V_SimdBinaryOp(_,V_SimdReg s1,V_SimdReg s2,_) -> 
      [V_SimdTmp s1; V_SimdTmp s2]
  | V_SimdTernaryOp(_,V_SimdReg s1,V_SimdReg s2, V_SimdReg s3,_) -> 
      [V_SimdTmp s1; V_SimdTmp s2; V_SimdTmp s3]

let vsimdinstrToSrcrawvars = function
  | V_SimdLoad2(_,idx,_)	  -> [V_SimdRawQVar idx]
  | V_SimdStore2 _		  -> []
  | V_SimdUnaryOp _		  -> []
  | V_SimdBinaryOp _		  -> []
  | V_SimdTernaryOp _		  -> []

let vsimdinstrToDstoperands = function
  | V_SimdLoad2(_,_,V_SimdReg d)      -> [V_SimdTmp d]
  | V_SimdStore2(_,arr,el) 	      -> [V_SimdQVar(arr,el)]
  | V_SimdTernaryOp(_,_,_,_,V_SimdReg d) -> [V_SimdTmp d]
  | V_SimdBinaryOp(_,_,_,V_SimdReg d)    -> [V_SimdTmp d]
  | V_SimdUnaryOp(_,_,V_SimdReg d)    -> [V_SimdTmp d]

(****************************************************************************)

let vsimdunaryopToConst = function
  | V_Id	    -> None
  | V_Swap 	    -> None
  | V_SwapChsL 	    -> None
  | V_SwapChsH 	    -> None
  | V_Chs V_ChsLo   -> Some (Number.mone, Number.one)
  | V_Chs V_ChsHi   -> Some (Number.one,  Number.mone)
  | V_Chs V_ChsLoHi -> Some (Number.mone, Number.mone)
  | V_MulConst(n,m) -> Some (n,m)

let vsimdbinaryopToConst = function 
  | V_Add2        -> None
  | V_Sub2        -> None
  | V_Mul2        -> None
  | V_Acc2 _      -> None
  | V_UnpackL     -> None
  | V_UnpackH     -> None
  | V_UnpackLH    -> None
  | V_FNMcA2(n,m) -> Some (n,m)
  | V_FMcA2(n,m)  -> Some (n,m)
  | V_FMcS2(n,m)  -> Some (n,m)

let vsimdinstrToConst = function
  | V_SimdLoad2 _             -> None
  | V_SimdStore2 _            -> None
  | V_SimdTernaryOp _         -> None
  | V_SimdUnaryOp(uop,_,_)    -> vsimdunaryopToConst uop
  | V_SimdBinaryOp(bop,_,_,_) -> vsimdbinaryopToConst bop

let vsimdinstrsToConsts xs =
  let rec loop bag = function
    | [] -> bag
    | x::xs -> 
        match vsimdinstrToConst x with
	  | None -> loop bag xs
	  | Some c -> loop (addelem' equal_numberpair c bag) xs
  in loop [] xs

(****************************************************************************)

let vsimdinstrsToDstregs xs = 
  let rec loop bag = function
    | [] -> bag
    | x::xs -> 
	match vsimdinstrToDstreg x with 
	  | Some d -> loop (d::bag) xs
	  | None -> loop bag xs
  in loop [] xs
