%
-% (c) The GRASP/AQUA Project, Glasgow University, 1994-1996
-% Hans Wolfgang Loidl
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
+% $Id: Costs.lhs,v 1.28 2001/01/15 16:55:24 sewardj Exp $
+%
+% Only needed in a GranSim setup -- HWL
% ---------------------------------------------------------------------------
\section[Costs]{Evaluating the costs of computing some abstract C code}
instructions.
\end{itemize}
-This function is needed in GrAnSim for parallelism.
+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!):
+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}
import AbsCSyn
import PrimOp ( primOpNeedsWrapper, PrimOp(..) )
-import GlaExts ( trace )
+import Panic ( trace )
-- --------------------------------------------------------------------------
-newtype CostRes = Cost (Int, Int, Int, Int, Int)
- deriving (Text)
+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
-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
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)
CAssign (CReg _) (CTemp _ _) -> Cost (1,0,0,0,0)
- CAssign (CReg _) (CAddr _) -> Cost (1,0,0,0,0) -- typ.: add %reg1,<adr>,%reg2
+ CAssign (CReg _) source_m -> addrModeCosts source_m Rhs
CAssign target_m source_m -> addrModeCosts target_m Lhs +
addrModeCosts source_m Rhs
CCodeBlock _ absC -> costs absC
- CInitHdr cl_info reg_rel cost_centre inplace_upd -> 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 primOp modes_args _ ->
{-
let
n = length modes_res
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
-- *** 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
- CClosureInfoAndCode _ _ _ _ _ _ -> nullCosts
+ CSRT _ _ -> nullCosts
+
+ CBitmap _ _ -> nullCosts
- CRetVector _ _ _ -> nullCosts
+ CClosureInfoAndCode _ _ _ _ -> nullCosts
- CRetUnVector _ _ -> nullCosts
+ CRetVector _ _ _ _ -> nullCosts
- CFlatRetVector _ _ -> nullCosts
+ CClosureTbl _ -> nullCosts
CCostCentreDecl _ _ -> nullCosts
- CClosureUpdInfo _ -> nullCosts
+ CCostCentreStackDecl _ -> nullCosts
CSplitMarker -> nullCosts
+ _ -> trace ("Costs.costs") nullCosts
+
-- ---------------------------------------------------------------------------
addrModeCosts :: CAddrMode -> Side -> CostRes
CVal _ _ -> if lhs then Cost (0, 0, 0, 1, 0)
else Cost (0, 0, 1, 0, 0)
- CAddr _ -> if lhs then Cost (0, 0, 0, 1, 0) -- ??unchecked
- 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 ! -}
+ CReg _ -> nullCosts {- loading from, storing to reg is free ! -}
{- for costing CReg->Creg ops see special -}
{- case in costs fct -}
- CTableEntry base_mode offset_mode kind ->
- addrModeCosts base_mode side +
- addrModeCosts offset_mode side +
- Cost (1,0,1,0,0)
CTemp _ _ -> nullCosts {- if lhs then Cost (0, 0, 0, 1, 0)
else Cost (0, 0, 1, 0, 0) -}
-- Rhs: typically: sethi %hi(lbl),%tmp_reg
-- or %tmp_reg,%lo(lbl),%target_reg
- CUnVecLbl _ _ -> if lhs then Cost (0, 0, 0, 1, 0)
- else Cost (2, 0, 0, 0, 0)
- -- same as CLbl
-
-- Check the following 3 (checked form CLit on)
CCharLike mode -> if lhs then Cost (0, 0, 0, 1, 0)
CIntLike mode -> if lhs then Cost (0, 0, 0, 1, 0)
else Cost (0, 0, 1, 0, 0)
- CString _ -> 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
- CLitLit _ _ -> if lhs then nullCosts
- else Cost (1, 0, 0, 0, 0)
- -- same es CLit
-
- COffset _ -> if lhs then nullCosts
- else Cost (1, 0, 0, 0, 0)
- -- same es CLit
-
- CCode absC -> costs absC
-
- CLabelledCode _ absC -> costs absC
-
- CJoinPoint _ _ -> if lhs then Cost (0, 0, 0, 1, 0)
+ 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
- CCostCentre _ _ -> nullCosts
-
-- ---------------------------------------------------------------------------
exprMacroCosts :: Side -> CExprMacro -> [CAddrMode] -> CostRes
in
arg_costs +
case macro of
- INFO_PTR -> if side == Lhs then Cost (0, 0, 0, 1, 0)
- else Cost (0, 0, 1, 0, 0)
- ENTRY_CODE -> nullCosts
- INFO_TAG -> if side == Lhs then Cost (0, 0, 0, 1, 0)
- else Cost (0, 0, 1, 0, 0)
- EVAL_TAG -> if side == Lhs then Cost (1, 0, 0, 1, 0)
- else Cost (1, 0, 1, 0, 0)
- -- costs of INFO_TAG + (1,0,0,0,0)
+ 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 =
- let
- arg_costs = foldl (+) nullCosts
- [addrModeCosts mode Rhs | mode <- modes]
- in
case macro of
- ARGS_CHK_A_LOAD_NODE -> Cost (2, 1, 0, 0, 0) {- StgMacros.lh -}
+ 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_A -> Cost (2, 1, 0, 0, 0) {- StgMacros.lh -}
- -- p=probability of PAP (instead of AP): + p*(0,1,0,0,0)
- ARGS_CHK_B_LOAD_NODE -> Cost (2, 1, 0, 0, 0) {- StgMacros.lh -}
- ARGS_CHK_B -> Cost (2, 1, 0, 0, 0) {- StgMacros.lh -}
- HEAP_CHK -> Cost (2, 1, 0, 0, 0) {- StgMacros.lh -}
- -- STK_CHK -> (2, 1, 0, 0, 0) {- StgMacros.lh -}
- STK_CHK -> Cost (0, 0, 0, 0, 0) {- StgMacros.lh -}
+ ARGS_CHK -> Cost (2, 1, 0, 0, 0) {- StgMacros.lh -}
UPD_CAF -> Cost (7, 0, 1, 3, 0) {- SMupdate.lh -}
- UPD_IND -> Cost (8, 2, 2, 0, 0) {- SMupdate.lh
- updatee in old-gen: Cost (4, 1, 1, 0, 0)
- updatee in new-gen: Cost (4, 1, 1, 0, 0)
- NB: we include costs fo checking if there is
- a BQ, but we omit costs for awakening BQ
- (these probably differ between old-gen and
- new gen) -}
- UPD_INPLACE_NOPTRS -> Cost (13, 3, 3, 2, 0) {- SMupdate.lh
- common for both: Cost (4, 1, 1, 0, 0)
- updatee in old-gen: Cost (14, 3, 2, 4, 0)
- updatee in new-gen: Cost (4, 1, 1, 0, 0) -}
- UPD_INPLACE_PTRS -> Cost (13, 3, 3, 2, 0) {- SMupdate.lh
- common for both: Cost (4, 1, 1, 0, 0)
- updatee in old-gen: Cost (14, 3, 2, 4, 0)
- updatee in new-gen: Cost (4, 1, 1, 0, 0) -}
-
UPD_BH_UPDATABLE -> Cost (3, 0, 0, 1, 0) {- SMupdate.lh -}
UPD_BH_SINGLE_ENTRY -> Cost (3, 0, 0, 1, 0) {- SMupdate.lh -}
- PUSH_STD_UPD_FRAME -> Cost (3, 0, 0, 4, 0) {- SMupdate.lh -}
- POP_STD_UPD_FRAME -> Cost (1, 0, 3, 0, 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: "++show macro) nullCosts
+ _ -> trace ("Costs.stmtMacroCosts") nullCosts
-- ---------------------------------------------------------------------------
, DoubleAsinOp , DoubleAcosOp , DoubleAtanOp
, DoubleSinhOp , DoubleCoshOp , DoubleTanhOp
, DoublePowerOp
- , FloatEncodeOp , FloatDecodeOp
- , DoubleEncodeOp , DoubleDecodeOp
+ , FloatDecodeOp
+ , DoubleDecodeOp
]
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
-- Special cases
-primOpCosts (CCallOp _ _ _ _ _) = SAVE_COSTS + RESTORE_COSTS
+primOpCosts (CCallOp _) = SAVE_COSTS + RESTORE_COSTS
-- don't guess costs of ccall proper
-- for exact costing use a GRAN_EXEC
-- in the C code
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 IntAbsOp = Cost (0, 1, 0, 0, 0) -- abs closure already costed
primOpCosts FloatGtOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
primOpCosts FloatGeOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
-}
-- ---------------------------------------------------------------------------
\end{code}
-
-This is the data structure of {\tt PrimOp} copied from prelude/PrimOp.lhs.
-I include here some comments about the estimated costs for these @PrimOps@.
-Compare with the @primOpCosts@ fct above. -- HWL
-
-\begin{pseudocode}
-data PrimOp
- -- I assume all these basic comparisons take just one ALU instruction
- -- Checked that for Char, Int; Word, Addr should be the same as Int.
-
- = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp
- | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp
- | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp
- | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp
-
- -- Analogously, these take one FP unit instruction
- -- Haven't checked that, yet.
-
- | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp
- | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
-
- -- 1 ALU op; unchecked
- | OrdOp | ChrOp
-
- -- these just take 1 ALU op; checked
- | IntAddOp | IntSubOp
-
- -- but these take more than that; see special cases in primOpCosts
- -- I counted the generated ass. instructions for these -> checked
- | IntMulOp | IntQuotOp
- | IntRemOp | IntNegOp | IntAbsOp
-
- -- Rest is unchecked so far -- HWL
-
- -- Word#-related ops:
- | AndOp | OrOp | NotOp | XorOp | ShiftLOp | ShiftROp
- | Int2WordOp | Word2IntOp -- casts
-
- -- Addr#-related ops:
- | Int2AddrOp | Addr2IntOp -- casts
-
- -- Float#-related ops:
- | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp
- | Float2IntOp | Int2FloatOp
-
- | FloatExpOp | FloatLogOp | FloatSqrtOp
- | FloatSinOp | FloatCosOp | FloatTanOp
- | FloatAsinOp | FloatAcosOp | FloatAtanOp
- | FloatSinhOp | FloatCoshOp | FloatTanhOp
- -- not all machines have these available conveniently:
- -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp
- | FloatPowerOp -- ** op
-
- -- Double#-related ops:
- | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp
- | Double2IntOp | Int2DoubleOp
- | Double2FloatOp | Float2DoubleOp
-
- | DoubleExpOp | DoubleLogOp | DoubleSqrtOp
- | DoubleSinOp | DoubleCosOp | DoubleTanOp
- | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp
- | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp
- -- not all machines have these available conveniently:
- -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp
- | DoublePowerOp -- ** op
-
- -- Integer (and related...) ops:
- -- slightly weird -- to match GMP package.
- | IntegerAddOp | IntegerSubOp | IntegerMulOp
- | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
-
- | IntegerCmpOp
-
- | Integer2IntOp | Int2IntegerOp
- | Addr2IntegerOp -- "Addr" is *always* a literal string
- -- ?? gcd, etc?
-
- | FloatEncodeOp | FloatDecodeOp
- | DoubleEncodeOp | DoubleDecodeOp
-
- -- primitive ops for primitive arrays
-
- | NewArrayOp
- | NewByteArrayOp PrimRep
-
- | SameMutableArrayOp
- | SameMutableByteArrayOp
-
- | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
-
- | ReadByteArrayOp PrimRep
- | WriteByteArrayOp PrimRep
- | IndexByteArrayOp PrimRep
- | IndexOffAddrOp PrimRep
- -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
- -- This is just a cheesy encoding of a bunch of ops.
- -- Note that ForeignObjRep is not included -- the only way of
- -- creating a ForeignObj is with a ccall or casm.
-
- | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
-
- | MakeStablePtrOp | DeRefStablePtrOp
-\end{pseudocode}
-
-A special ``trap-door'' to use in making calls direct to C functions:
-Note: From GrAn point of view, CCall is probably very expensive
- The programmer can specify the costs of the Ccall by inserting
- a GRAN_EXEC(a,b,l,s,f) at the end of the C- code, specifing the
- number or arithm., branch, load, store and floating point instructions
- -- HWL
-
-\begin{pseudocode}
- | CCallOp String -- An "unboxed" ccall# to this named function
- Bool -- True <=> really a "casm"
- Bool -- True <=> might invoke Haskell GC
- [Type] -- Unboxed argument; the state-token
- -- argument will have been put *first*
- Type -- Return type; one of the "StateAnd<blah>#" types
-
- -- (... to be continued ... )
-\end{pseudocode}