%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: Costs.lhs,v 1.29 2001/05/22 13:43:14 simonpj Exp $
%
% Only needed in a GranSim setup -- HWL
% ---------------------------------------------------------------------------

\section[Costs]{Evaluating the costs of computing some abstract C code}

This module   provides all necessary  functions for   computing for a given
abstract~C Program the costs of executing that program. This is done by the
exported function:

\begin{quote}
 {\verb type CostRes = (Int, Int, Int, Int, Int)}
 {\verb costs :: AbstractC -> CostRes }
\end{quote}

The meaning of the result tuple is:
\begin{itemize}
 \item The first component ({\tt i}) counts the number of integer,
   arithmetic and bit-manipulating instructions.
 \item The second component ({\tt b}) counts the number of branches (direct
   branches as well as indirect ones).
 \item The third component ({\tt l}) counts the number of load instructions.
 \item The fourth component ({\tt s}) counts the number of store
   instructions.
 \item The fifth component ({\tt f}) counts the number of floating point
   instructions.
\end{itemize}

This function is needed in GranSim for costing pieces of abstract C.

These are first suggestions for scaling the costs. But, this scaling should
be done in the RTS rather than the compiler (this really should be
tunable!):

\begin{pseudocode}

#define LOAD_COSTS		2
#define STORE_COSTS		2
#define INT_ARITHM_COSTS	1
#define GMP_ARITHM_COSTS	3 {- any clue for GMP costs ? -}
#define FLOAT_ARITHM_COSTS	3 {- any clue for float costs ? -}
#define BRANCH_COSTS		2

\end{pseudocode}

\begin{code}
#define ACCUM_COSTS(i,b,l,s,f)	(i+b+l+s+f)

#define NUM_REGS		10 {- PprAbsCSyn.lhs -}	      {- runtime/c-as-asm/CallWrap_C.lc -}
#define RESTORE_COSTS		(Cost (0, 0, NUM_REGS, 0, 0)  :: CostRes)
#define SAVE_COSTS		(Cost (0, 0, 0, NUM_REGS, 0)  :: CostRes)
#define CCALL_COSTS_GUESS	(Cost (50, 0, 0, 0, 0)	      :: CostRes)

module Costs( costs,
	      addrModeCosts, CostRes(Cost), nullCosts, Side(..)
    ) where

#include "HsVersions.h"

import AbsCSyn
import StgSyn		( StgOp(..) )
import PrimOp		( primOpNeedsWrapper, PrimOp(..) )
import Panic		( trace )

-- --------------------------------------------------------------------------
data CostRes = Cost (Int, Int, Int, Int, Int)
	       deriving (Show)

nullCosts    = Cost (0, 0, 0, 0, 0) :: CostRes
initHdrCosts = Cost (2, 0, 0, 1, 0) :: CostRes

instance Eq CostRes where
 (==) t1 t2 = i && b && l && s && f
	     where (i,b,l,s,f) = binOp' (==) t1 t2

instance Num CostRes where
 (+) = binOp (+)
 (-) = binOp (-)
 (*) = binOp (*)
 negate	 = mapOp negate
 abs	 = mapOp abs
 signum	 = mapOp signum
 fromInteger _ = error "fromInteger not defined"

mapOp :: (Int -> Int) -> CostRes -> CostRes
mapOp g ( Cost (i, b, l, s, f) )  = Cost (g i, g b, g l, g s, g f)

binOp :: (Int -> Int -> Int) -> CostRes -> CostRes -> CostRes
binOp o ( Cost (i1, b1, l1, s1, f1) ) ( Cost  (i2, b2, l2, s2, f2) )  =
	( Cost (i1 `o` i2, b1 `o` b2, l1 `o` l2, s1 `o` s2, f1 `o` f2) )

binOp' :: (Int -> Int -> a) -> CostRes -> CostRes -> (a,a,a,a,a)
binOp' o ( Cost (i1, b1, l1, s1, f1) ) ( Cost  (i2, b2, l2, s2, f2) )  =
	 (i1 `o` i2, b1 `o` b2, l1 `o` l2, s1 `o` s2, f1 `o` f2)

-- --------------------------------------------------------------------------

data Side = Lhs | Rhs
	    deriving (Eq)

-- --------------------------------------------------------------------------

costs :: AbstractC -> CostRes

costs absC =
  case absC of
   AbsCNop			->  nullCosts

   AbsCStmts absC1 absC2	-> costs absC1 + costs absC2

   CAssign (CReg _) (CReg _)	-> Cost (1,0,0,0,0)   -- typ.: mov %reg1,%reg2

   CAssign (CReg _) (CTemp _ _) -> Cost (1,0,0,0,0)

   CAssign (CReg _) source_m	-> addrModeCosts source_m Rhs

   CAssign target_m source_m	-> addrModeCosts target_m Lhs +
				   addrModeCosts source_m Rhs

   CJump (CLbl _  _)		-> Cost (0,1,0,0,0)  -- no ld for call necessary

   CJump mode			-> addrModeCosts mode Rhs +
				   Cost (0,1,0,0,0)

   CFallThrough mode  -> addrModeCosts mode Rhs +		-- chu' 0.24
			 Cost (0,1,0,0,0)

   CReturn mode info  -> case info of
			  DirectReturn -> addrModeCosts mode Rhs +
					  Cost (0,1,0,0,0)

			    -- i.e. ld address to reg and call reg

			  DynamicVectoredReturn mode' ->
					addrModeCosts mode Rhs +
					addrModeCosts mode' Rhs +
					Cost (0,1,1,0,0)

			    {- generates code like this:
				JMP_(<mode>)[RVREL(<mode'>)];
			       i.e. 1 possb ld for mode'
				    1 ld for RVREL
				    1 possb ld for mode
				    1 call				-}

			  StaticVectoredReturn _ -> addrModeCosts mode Rhs +
						  Cost (0,1,1,0,0)

			    -- as above with mode' fixed to CLit
			    -- typically 2 ld + 1 call; 1st ld due
			    -- to CVal as mode

   CSwitch mode alts absC     -> nullCosts
				 {- for handling costs of all branches of
				    a CSwitch see PprAbsC.
				    Basically:
				     Costs for branch =
					Costs before CSwitch +
					addrModeCosts of head +
					Costs for 1 cond branch +
					Costs for body of branch
				 -}

   CCodeBlock _ absC	      -> costs absC

   CInitHdr cl_info reg_rel cost_centre -> initHdrCosts

			{- This is more fancy but superflous: The addr modes
			   are fixed and so the costs are const!

			argCosts + initHdrCosts
			where argCosts = addrModeCosts (CAddr reg_rel) Rhs +
					 addrModeCosts base_lbl +    -- CLbl!
					 3*addrModeCosts (mkIntCLit 1{- any val -})
			-}
			{- this extends to something like
			    SET_SPEC_HDR(...)
			   For costing the args of this macro
			   see PprAbsC.lhs where args are inserted -}

   COpStmt modes_res op modes_args _ ->
	{-
	   let
		n = length modes_res
	   in
		(0, 0, n, n, 0) +
		primOpCosts primOp +
		if primOpNeedsWrapper primOp then SAVE_COSTS + RESTORE_COSTS
					     else nullCosts
	   -- ^^HWL
	-}
	foldl (+) nullCosts [addrModeCosts mode Lhs | mode <- modes_res]  +
	foldl (+) nullCosts [addrModeCosts mode Rhs | mode <- modes_args]  +
	opCosts op

   CSimultaneous absC	     -> costs absC

   CCheck _ amodes code	     -> Cost (2, 1, 0, 0, 0) -- ToDo: refine this by 
                                                     -- looking at the first arg 

   CRetDirect _ _ _ _	     -> nullCosts

   CMacroStmt	macro modes  -> stmtMacroCosts macro modes

   CCallProfCtrMacro   _ _   -> nullCosts
				  {- we don't count profiling in GrAnSim -}

   CCallProfCCMacro    _ _   -> nullCosts
				  {- we don't count profiling in GrAnSim -}

  -- *** the next three [or so...] are DATA (those above are CODE) ***
  -- as they are data rather than code they all have nullCosts	       -- HWL

   CCallTypedef _ _ _ _ _    -> nullCosts

   CStaticClosure _ _ _ _    -> nullCosts

   CSRT _ _                  -> nullCosts

   CBitmap _ _               -> nullCosts

   CClosureInfoAndCode _ _ _ _ -> nullCosts

   CRetVector _ _ _ _        -> nullCosts

   CClosureTbl _             -> nullCosts

   CCostCentreDecl _ _	     -> nullCosts

   CCostCentreStackDecl _    -> nullCosts

   CSplitMarker		     -> nullCosts

   _ -> trace ("Costs.costs") nullCosts


-- ---------------------------------------------------------------------------

addrModeCosts :: CAddrMode -> Side -> CostRes

-- addrModeCosts _ _ = nullCosts

addrModeCosts addr_mode side =
  let
    lhs = side == Lhs
  in
  case addr_mode of
    CVal _ _ -> if lhs then Cost (0, 0, 0, 1, 0)
		       else Cost (0, 0, 1, 0, 0)

    CAddr (CIndex _ n _ ) -> Cost (1, 0, 1, 0, 0) -- does pointer arithmetic

    CAddr _ -> nullCosts

    CReg _  -> nullCosts	 {- loading from, storing to reg is free ! -}
				 {- for costing CReg->Creg ops see special -}
				 {- case in costs fct -}

    CTemp _ _  -> nullCosts	{- if lhs then Cost (0, 0, 0, 1, 0)
					  else Cost (0, 0, 1, 0, 0)  -}
	-- ``Temporaries'' correspond to local variables in C, and registers in
	-- native code.
	-- I assume they can be somewhat optimized by gcc -- HWL

    CLbl _ _   -> if lhs then Cost (0, 0, 0, 1, 0)
			 else Cost (2, 0, 0, 0, 0)
		  -- Rhs: typically: sethi %hi(lbl),%tmp_reg
		  --		     or	   %tmp_reg,%lo(lbl),%target_reg

    --	Check the following 3 (checked form CLit on)

    CCharLike mode -> if lhs then Cost (0, 0, 0, 1, 0)
			     else Cost (0, 0, 1, 0, 0)

    CIntLike mode  -> if lhs then Cost (0, 0, 0, 1, 0)
			     else Cost (0, 0, 1, 0, 0)

    CLit    _	   -> if lhs then nullCosts	       -- should never occur
			     else Cost (1, 0, 0, 0, 0) -- typ.: mov lit,%reg

    CJoinPoint _	  -> if lhs then Cost (0, 0, 0, 1, 0)
				    else Cost (0, 0, 1, 0, 0)

    CMacroExpr _ macro mode_list -> exprMacroCosts side macro mode_list

-- ---------------------------------------------------------------------------

exprMacroCosts :: Side -> CExprMacro -> [CAddrMode] -> CostRes

exprMacroCosts side macro mode_list =
  let
    arg_costs = foldl (+) nullCosts
		      (map (\ x -> addrModeCosts x Rhs) mode_list)
  in
  arg_costs +
  case macro of
    ENTRY_CODE -> nullCosts -- nothing 
    ARG_TAG -> nullCosts -- nothing
    GET_TAG -> Cost (0, 0, 1, 0, 0)  -- indirect load
    UPD_FRAME_UPDATEE -> Cost (0, 0, 1, 0, 0)  -- indirect load

-- ---------------------------------------------------------------------------

stmtMacroCosts :: CStmtMacro -> [CAddrMode] -> CostRes

stmtMacroCosts macro modes =
  case macro of
    ARGS_CHK_LOAD_NODE  ->  Cost (2, 1, 0, 0, 0)	 {- StgMacros.lh  -}
		-- p=probability of PAP (instead of AP): + p*(3,1,0,0,0)
    ARGS_CHK		  ->  Cost (2, 1, 0, 0, 0)	 {- StgMacros.lh  -}
    UPD_CAF		  ->  Cost (7, 0, 1, 3, 0)	 {- SMupdate.lh	 -}
    UPD_BH_UPDATABLE	  ->  Cost (3, 0, 0, 1, 0)	 {- SMupdate.lh	 -}
    UPD_BH_SINGLE_ENTRY	  ->  Cost (3, 0, 0, 1, 0)	 {- SMupdate.lh	 -}
    PUSH_UPD_FRAME	  ->  Cost (3, 0, 0, 4, 0)	 {- Updates.h	 -}
    PUSH_SEQ_FRAME	  ->  Cost (2, 0, 0, 3, 0)	 {- StgMacros.h	 !-}
    UPDATE_SU_FROM_UPD_FRAME -> Cost (1, 0, 1, 0, 0)     {- StgMacros.h	 !-}
    SET_TAG		  ->  nullCosts		    {- COptRegs.lh -}
    GRAN_FETCH			->  nullCosts	  {- GrAnSim bookkeeping -}
    GRAN_RESCHEDULE		->  nullCosts	  {- GrAnSim bookkeeping -}
    GRAN_FETCH_AND_RESCHEDULE	->  nullCosts	  {- GrAnSim bookkeeping -}
    GRAN_YIELD		        ->  nullCosts	  {- GrAnSim bookkeeping -- added SOF -}
    THREAD_CONTEXT_SWITCH	->  nullCosts	  {- GrAnSim bookkeeping -}
    _ -> trace ("Costs.stmtMacroCosts") nullCosts

-- ---------------------------------------------------------------------------

floatOps :: [PrimOp]
floatOps =
  [   FloatGtOp	 , FloatGeOp  , FloatEqOp  , FloatNeOp	, FloatLtOp  , FloatLeOp
    , DoubleGtOp , DoubleGeOp , DoubleEqOp , DoubleNeOp , DoubleLtOp , DoubleLeOp
    , FloatAddOp , FloatSubOp , FloatMulOp , FloatDivOp , FloatNegOp
    , Float2IntOp , Int2FloatOp
    , FloatExpOp   , FloatLogOp	  , FloatSqrtOp
    , FloatSinOp   , FloatCosOp	  , FloatTanOp
    , FloatAsinOp  , FloatAcosOp  , FloatAtanOp
    , FloatSinhOp  , FloatCoshOp  , FloatTanhOp
    , FloatPowerOp
    , DoubleAddOp , DoubleSubOp , DoubleMulOp , DoubleDivOp , DoubleNegOp
    , Double2IntOp , Int2DoubleOp
    , Double2FloatOp , Float2DoubleOp
    , DoubleExpOp   , DoubleLogOp   , DoubleSqrtOp
    , DoubleSinOp   , DoubleCosOp   , DoubleTanOp
    , DoubleAsinOp  , DoubleAcosOp  , DoubleAtanOp
    , DoubleSinhOp  , DoubleCoshOp  , DoubleTanhOp
    , DoublePowerOp
    , FloatDecodeOp
    , DoubleDecodeOp
  ]

gmpOps :: [PrimOp]
gmpOps	=
  [   IntegerAddOp , IntegerSubOp , IntegerMulOp
    , IntegerQuotRemOp , IntegerDivModOp
    , IntegerCmpOp
    , Integer2IntOp  , Int2IntegerOp
  ]


umul_costs = Cost (21,4,0,0,0)	   -- due to spy counts
rem_costs =  Cost (30,15,0,0,0)	   -- due to spy counts
div_costs =  Cost (30,15,0,0,0)	   -- due to spy counts



-- ---------------------------------------------------------------------------

opCosts :: StgOp -> CostRes

opCosts (StgFCallOp _ _) = SAVE_COSTS + RESTORE_COSTS  	
	-- Don't guess costs of ccall proper
        -- for exact costing use a GRAN_EXEC in the C code

opCosts (StgPrimOp primop)
  = primOpCosts primop +
    if primOpNeedsWrapper primop then SAVE_COSTS + RESTORE_COSTS
				 else nullCosts

primOpCosts :: PrimOp -> CostRes

-- Usually 3 mov instructions are needed to get args and res in right place.
primOpCosts IntMulOp  = Cost (3, 1, 0, 0, 0)  + umul_costs
primOpCosts IntQuotOp = Cost (3, 1, 0, 0, 0)  + div_costs
primOpCosts IntRemOp  = Cost (3, 1, 0, 0, 0)  + rem_costs
primOpCosts IntNegOp  = Cost (1, 1, 0, 0, 0) -- translates into 1 sub

primOpCosts FloatGtOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
primOpCosts FloatGeOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
primOpCosts FloatEqOp  = Cost (0, 0, 0, 0, 2) -- cheap f-comp
primOpCosts FloatNeOp  = Cost (0, 0, 0, 0, 2) -- cheap f-comp
primOpCosts FloatLtOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
primOpCosts FloatLeOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
primOpCosts DoubleGtOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
primOpCosts DoubleGeOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
primOpCosts DoubleEqOp = Cost (0, 0, 0, 0, 2) -- cheap f-comp
primOpCosts DoubleNeOp = Cost (0, 0, 0, 0, 2) -- cheap f-comp
primOpCosts DoubleLtOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
primOpCosts DoubleLeOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp

primOpCosts FloatExpOp	  = Cost (2, 1, 4, 4, 3)
primOpCosts FloatLogOp	  = Cost (2, 1, 4, 4, 3)
primOpCosts FloatSqrtOp	  = Cost (2, 1, 4, 4, 3)
primOpCosts FloatSinOp	  = Cost (2, 1, 4, 4, 3)
primOpCosts FloatCosOp	  = Cost (2, 1, 4, 4, 3)
primOpCosts FloatTanOp	  = Cost (2, 1, 4, 4, 3)
primOpCosts FloatAsinOp	  = Cost (2, 1, 4, 4, 3)
primOpCosts FloatAcosOp	  = Cost (2, 1, 4, 4, 3)
primOpCosts FloatAtanOp	  = Cost (2, 1, 4, 4, 3)
primOpCosts FloatSinhOp	  = Cost (2, 1, 4, 4, 3)
primOpCosts FloatCoshOp	  = Cost (2, 1, 4, 4, 3)
primOpCosts FloatTanhOp	  = Cost (2, 1, 4, 4, 3)
--primOpCosts FloatAsinhOp  = Cost (2, 1, 4, 4, 3)
--primOpCosts FloatAcoshOp  = Cost (2, 1, 4, 4, 3)
--primOpCosts FloatAtanhOp  = Cost (2, 1, 4, 4, 3)
primOpCosts FloatPowerOp  = Cost (2, 1, 4, 4, 3)

{- There should be special handling of the Array PrimOps in here   HWL -}

primOpCosts primOp
  | primOp `elem` floatOps = Cost (0, 0, 0, 0, 1)  :: CostRes
  | primOp `elem` gmpOps   = Cost (30, 5, 10, 10, 0) :: CostRes  -- GUESS; check it
  | otherwise		   = Cost (1, 0, 0, 0, 0)

\end{code}
