%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: Costs.lhs,v 1.21 2000/03/23 17:45:17 simonpj Exp $
+% $Id: Costs.lhs,v 1.33 2003/07/28 16:05:30 simonmar Exp $
%
% Only needed in a GranSim setup -- HWL
% ---------------------------------------------------------------------------
#include "HsVersions.h"
import AbsCSyn
+import StgSyn ( StgOp(..) )
import PrimOp ( primOpNeedsWrapper, PrimOp(..) )
import Panic ( trace )
-- --------------------------------------------------------------------------
data CostRes = Cost (Int, Int, Int, Int, Int)
- deriving (Text)
+ deriving (Show)
nullCosts = Cost (0, 0, 0, 0, 0) :: CostRes
initHdrCosts = Cost (2, 0, 0, 1, 0) :: CostRes
-errorCosts = Cost (-1, -1, -1, -1, -1) -- just for debugging
-
-oneArithm = Cost (1, 0, 0, 0, 0) :: CostRes
instance Eq CostRes where
(==) t1 t2 = i && b && l && s && f
mapOp :: (Int -> Int) -> CostRes -> CostRes
mapOp g ( Cost (i, b, l, s, f) ) = Cost (g i, g b, g l, g s, g f)
-foldrOp :: (Int -> a -> a) -> a -> CostRes -> a
-foldrOp o x ( Cost (i1, b1, l1, s1, f1) ) =
- i1 `o` ( b1 `o` ( l1 `o` ( s1 `o` ( f1 `o` x))))
-
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) )
CCodeBlock _ absC -> costs absC
- CInitHdr cl_info reg_rel cost_centre -> initHdrCosts
+ 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!
For costing the args of this macro
see PprAbsC.lhs where args are inserted -}
- COpStmt modes_res primOp modes_args _ ->
+ COpStmt modes_res op modes_args _ ->
{-
let
n = length modes_res
-}
foldl (+) nullCosts [addrModeCosts mode Lhs | mode <- modes_res] +
foldl (+) nullCosts [addrModeCosts mode Rhs | mode <- modes_args] +
- primOpCosts primOp +
- if primOpNeedsWrapper primOp then SAVE_COSTS + RESTORE_COSTS
- else nullCosts
+ opCosts op
CSimultaneous absC -> costs absC
-- *** 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
+ CCallTypedef _ _ _ _ _ -> nullCosts
CStaticClosure _ _ _ _ -> nullCosts
CSRT _ _ -> nullCosts
- CBitmap _ _ -> nullCosts
+ CBitmap _ -> nullCosts
- CClosureInfoAndCode _ _ _ _ -> nullCosts
+ CClosureInfoAndCode _ _ -> nullCosts
CRetVector _ _ _ _ -> nullCosts
_ -> trace ("Costs.costs") nullCosts
+
-- ---------------------------------------------------------------------------
addrModeCosts :: CAddrMode -> Side -> CostRes
CLit _ -> if lhs then nullCosts -- should never occur
else Cost (1, 0, 0, 0, 0) -- typ.: mov lit,%reg
- CLitLit _ _ -> if lhs then nullCosts
- else Cost (1, 0, 0, 0, 0)
- -- same es CLit
-
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
- _ -> trace ("Costs.addrModeCosts") nullCosts
-
-- ---------------------------------------------------------------------------
exprMacroCosts :: Side -> CExprMacro -> [CAddrMode] -> CostRes
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
- _ -> trace ("Costs.exprMacroCosts") nullCosts
-- ---------------------------------------------------------------------------
stmtMacroCosts :: CStmtMacro -> [CAddrMode] -> CostRes
stmtMacroCosts macro modes =
- let
- arg_costs = foldl (+) nullCosts
- [addrModeCosts mode Rhs | mode <- modes]
- in
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 -}
gmpOps :: [PrimOp]
gmpOps =
[ IntegerAddOp , IntegerSubOp , IntegerMulOp
- , IntegerQuotRemOp , IntegerDivModOp , IntegerNegOp
+ , IntegerQuotRemOp , IntegerDivModOp
, IntegerCmpOp
, Integer2IntOp , Int2IntegerOp
- , Addr2IntegerOp
]
-abs_costs = nullCosts -- NB: This is normal STG code with costs already
- -- included; no need to add costs again.
-
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
-primOpCosts :: PrimOp -> CostRes
--- Special cases
-primOpCosts (CCallOp _) = SAVE_COSTS + RESTORE_COSTS
- -- don't guess costs of ccall proper
- -- for exact costing use a GRAN_EXEC
- -- in the C code
+-- ---------------------------------------------------------------------------
--- Usually 3 mov instructions are needed to get args and res in right place.
+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
| primOp `elem` gmpOps = Cost (30, 5, 10, 10, 0) :: CostRes -- GUESS; check it
| otherwise = Cost (1, 0, 0, 0, 0)
--- ---------------------------------------------------------------------------
-{- HWL: currently unused
-
-costsByKind :: PrimRep -> Side -> CostRes
-
--- The following PrimKinds say that the data is already in a reg
-
-costsByKind CharRep _ = nullCosts
-costsByKind IntRep _ = nullCosts
-costsByKind WordRep _ = nullCosts
-costsByKind AddrRep _ = nullCosts
-costsByKind FloatRep _ = nullCosts
-costsByKind DoubleRep _ = nullCosts
--}
--- ---------------------------------------------------------------------------
\end{code}
projects / ghc-hetmet.git / blobdiff