ghc/compiler/absCSyn/Costs.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 % $Id: Costs.lhs,v 1.31 2002/01/02 12:32:19 simonmar Exp $
   5 %
   6 % Only needed in a GranSim setup -- HWL
   7 % ---------------------------------------------------------------------------
   8
   9 \section[Costs]{Evaluating the costs of computing some abstract C code}
  10
  11 This module   provides all necessary  functions for   computing for a given
  12 abstract~C Program the costs of executing that program. This is done by the
  13 exported function:
  14
  15 \begin{quote}
  16  {\verb type CostRes = (Int, Int, Int, Int, Int)}
  17  {\verb costs :: AbstractC -> CostRes }
  18 \end{quote}
  19
  20 The meaning of the result tuple is:
  21 \begin{itemize}
  22  \item The first component ({\tt i}) counts the number of integer,
  23    arithmetic and bit-manipulating instructions.
  24  \item The second component ({\tt b}) counts the number of branches (direct
  25    branches as well as indirect ones).
  26  \item The third component ({\tt l}) counts the number of load instructions.
  27  \item The fourth component ({\tt s}) counts the number of store
  28    instructions.
  29  \item The fifth component ({\tt f}) counts the number of floating point
  30    instructions.
  31 \end{itemize}
  32
  33 This function is needed in GranSim for costing pieces of abstract C.
  34
  35 These are first suggestions for scaling the costs. But, this scaling should
  36 be done in the RTS rather than the compiler (this really should be
  37 tunable!):
  38
  39 \begin{pseudocode}
  40
  41 #define LOAD_COSTS              2
  42 #define STORE_COSTS             2
  43 #define INT_ARITHM_COSTS        1
  44 #define GMP_ARITHM_COSTS        3 {- any clue for GMP costs ? -}
  45 #define FLOAT_ARITHM_COSTS      3 {- any clue for float costs ? -}
  46 #define BRANCH_COSTS            2
  47
  48 \end{pseudocode}
  49
  50 \begin{code}
  51 #define ACCUM_COSTS(i,b,l,s,f)  (i+b+l+s+f)
  52
  53 #define NUM_REGS                10 {- PprAbsCSyn.lhs -}       {- runtime/c-as-asm/CallWrap_C.lc -}
  54 #define RESTORE_COSTS           (Cost (0, 0, NUM_REGS, 0, 0)  :: CostRes)
  55 #define SAVE_COSTS              (Cost (0, 0, 0, NUM_REGS, 0)  :: CostRes)
  56 #define CCALL_COSTS_GUESS       (Cost (50, 0, 0, 0, 0)        :: CostRes)
  57
  58 module Costs( costs,
  59               addrModeCosts, CostRes(Cost), nullCosts, Side(..)
  60     ) where
  61
  62 #include "HsVersions.h"
  63
  64 import AbsCSyn
  65 import StgSyn           ( StgOp(..) )
  66 import PrimOp           ( primOpNeedsWrapper, PrimOp(..) )
  67 import Panic            ( trace )
  68
  69 -- --------------------------------------------------------------------------
  70 data CostRes = Cost (Int, Int, Int, Int, Int)
  71                deriving (Show)
  72
  73 nullCosts    = Cost (0, 0, 0, 0, 0) :: CostRes
  74 initHdrCosts = Cost (2, 0, 0, 1, 0) :: CostRes
  75
  76 instance Eq CostRes where
  77  (==) t1 t2 = i && b && l && s && f
  78              where (i,b,l,s,f) = binOp' (==) t1 t2
  79
  80 instance Num CostRes where
  81  (+) = binOp (+)
  82  (-) = binOp (-)
  83  (*) = binOp (*)
  84  negate  = mapOp negate
  85  abs     = mapOp abs
  86  signum  = mapOp signum
  87  fromInteger _ = error "fromInteger not defined"
  88
  89 mapOp :: (Int -> Int) -> CostRes -> CostRes
  90 mapOp g ( Cost (i, b, l, s, f) )  = Cost (g i, g b, g l, g s, g f)
  91
  92 binOp :: (Int -> Int -> Int) -> CostRes -> CostRes -> CostRes
  93 binOp o ( Cost (i1, b1, l1, s1, f1) ) ( Cost  (i2, b2, l2, s2, f2) )  =
  94         ( Cost (i1 `o` i2, b1 `o` b2, l1 `o` l2, s1 `o` s2, f1 `o` f2) )
  95
  96 binOp' :: (Int -> Int -> a) -> CostRes -> CostRes -> (a,a,a,a,a)
  97 binOp' o ( Cost (i1, b1, l1, s1, f1) ) ( Cost  (i2, b2, l2, s2, f2) )  =
  98          (i1 `o` i2, b1 `o` b2, l1 `o` l2, s1 `o` s2, f1 `o` f2)
  99
 100 -- --------------------------------------------------------------------------
 101
 102 data Side = Lhs | Rhs
 103             deriving (Eq)
 104
 105 -- --------------------------------------------------------------------------
 106
 107 costs :: AbstractC -> CostRes
 108
 109 costs absC =
 110   case absC of
 111    AbsCNop                      ->  nullCosts
 112
 113    AbsCStmts absC1 absC2        -> costs absC1 + costs absC2
 114
 115    CAssign (CReg _) (CReg _)    -> Cost (1,0,0,0,0)   -- typ.: mov %reg1,%reg2
 116
 117    CAssign (CReg _) (CTemp _ _) -> Cost (1,0,0,0,0)
 118
 119    CAssign (CReg _) source_m    -> addrModeCosts source_m Rhs
 120
 121    CAssign target_m source_m    -> addrModeCosts target_m Lhs +
 122                                    addrModeCosts source_m Rhs
 123
 124    CJump (CLbl _  _)            -> Cost (0,1,0,0,0)  -- no ld for call necessary
 125
 126    CJump mode                   -> addrModeCosts mode Rhs +
 127                                    Cost (0,1,0,0,0)
 128
 129    CFallThrough mode  -> addrModeCosts mode Rhs +               -- chu' 0.24
 130                          Cost (0,1,0,0,0)
 131
 132    CReturn mode info  -> case info of
 133                           DirectReturn -> addrModeCosts mode Rhs +
 134                                           Cost (0,1,0,0,0)
 135
 136                             -- i.e. ld address to reg and call reg
 137
 138                           DynamicVectoredReturn mode' ->
 139                                         addrModeCosts mode Rhs +
 140                                         addrModeCosts mode' Rhs +
 141                                         Cost (0,1,1,0,0)
 142
 143                             {- generates code like this:
 144                                 JMP_(<mode>)[RVREL(<mode'>)];
 145                                i.e. 1 possb ld for mode'
 146                                     1 ld for RVREL
 147                                     1 possb ld for mode
 148                                     1 call                              -}
 149
 150                           StaticVectoredReturn _ -> addrModeCosts mode Rhs +
 151                                                   Cost (0,1,1,0,0)
 152
 153                             -- as above with mode' fixed to CLit
 154                             -- typically 2 ld + 1 call; 1st ld due
 155                             -- to CVal as mode
 156
 157    CSwitch mode alts absC     -> nullCosts
 158                                  {- for handling costs of all branches of
 159                                     a CSwitch see PprAbsC.
 160                                     Basically:
 161                                      Costs for branch =
 162                                         Costs before CSwitch +
 163                                         addrModeCosts of head +
 164                                         Costs for 1 cond branch +
 165                                         Costs for body of branch
 166                                  -}
 167
 168    CCodeBlock _ absC          -> costs absC
 169
 170    CInitHdr cl_info reg_rel cost_centre _ -> initHdrCosts
 171
 172                         {- This is more fancy but superflous: The addr modes
 173                            are fixed and so the costs are const!
 174
 175                         argCosts + initHdrCosts
 176                         where argCosts = addrModeCosts (CAddr reg_rel) Rhs +
 177                                          addrModeCosts base_lbl +    -- CLbl!
 178                                          3*addrModeCosts (mkIntCLit 1{- any val -})
 179                         -}
 180                         {- this extends to something like
 181                             SET_SPEC_HDR(...)
 182                            For costing the args of this macro
 183                            see PprAbsC.lhs where args are inserted -}
 184
 185    COpStmt modes_res op modes_args _ ->
 186         {-
 187            let
 188                 n = length modes_res
 189            in
 190                 (0, 0, n, n, 0) +
 191                 primOpCosts primOp +
 192                 if primOpNeedsWrapper primOp then SAVE_COSTS + RESTORE_COSTS
 193                                              else nullCosts
 194            -- ^^HWL
 195         -}
 196         foldl (+) nullCosts [addrModeCosts mode Lhs | mode <- modes_res]  +
 197         foldl (+) nullCosts [addrModeCosts mode Rhs | mode <- modes_args]  +
 198         opCosts op
 199
 200    CSimultaneous absC        -> costs absC
 201
 202    CCheck _ amodes code      -> Cost (2, 1, 0, 0, 0) -- ToDo: refine this by
 203                                                      -- looking at the first arg
 204
 205    CRetDirect _ _ _ _        -> nullCosts
 206
 207    CMacroStmt   macro modes  -> stmtMacroCosts macro modes
 208
 209    CCallProfCtrMacro   _ _   -> nullCosts
 210                                   {- we don't count profiling in GrAnSim -}
 211
 212    CCallProfCCMacro    _ _   -> nullCosts
 213                                   {- we don't count profiling in GrAnSim -}
 214
 215   -- *** the next three [or so...] are DATA (those above are CODE) ***
 216   -- as they are data rather than code they all have nullCosts         -- HWL
 217
 218    CCallTypedef _ _ _ _ _    -> nullCosts
 219
 220    CStaticClosure _ _ _      -> nullCosts
 221
 222    CSRT _ _                  -> nullCosts
 223
 224    CBitmap _ _               -> nullCosts
 225
 226    CClosureInfoAndCode _ _ _ _ -> nullCosts
 227
 228    CRetVector _ _ _ _        -> nullCosts
 229
 230    CClosureTbl _             -> nullCosts
 231
 232    CCostCentreDecl _ _       -> nullCosts
 233
 234    CCostCentreStackDecl _    -> nullCosts
 235
 236    CSplitMarker              -> nullCosts
 237
 238    _ -> trace ("Costs.costs") nullCosts
 239
 240
 241 -- ---------------------------------------------------------------------------
 242
 243 addrModeCosts :: CAddrMode -> Side -> CostRes
 244
 245 -- addrModeCosts _ _ = nullCosts
 246
 247 addrModeCosts addr_mode side =
 248   let
 249     lhs = side == Lhs
 250   in
 251   case addr_mode of
 252     CVal _ _ -> if lhs then Cost (0, 0, 0, 1, 0)
 253                        else Cost (0, 0, 1, 0, 0)
 254
 255     CAddr (CIndex _ n _ ) -> Cost (1, 0, 1, 0, 0) -- does pointer arithmetic
 256
 257     CAddr _ -> nullCosts
 258
 259     CReg _  -> nullCosts         {- loading from, storing to reg is free ! -}
 260                                  {- for costing CReg->Creg ops see special -}
 261                                  {- case in costs fct -}
 262
 263     CTemp _ _  -> nullCosts     {- if lhs then Cost (0, 0, 0, 1, 0)
 264                                           else Cost (0, 0, 1, 0, 0)  -}
 265         -- ``Temporaries'' correspond to local variables in C, and registers in
 266         -- native code.
 267         -- I assume they can be somewhat optimized by gcc -- HWL
 268
 269     CLbl _ _   -> if lhs then Cost (0, 0, 0, 1, 0)
 270                          else Cost (2, 0, 0, 0, 0)
 271                   -- Rhs: typically: sethi %hi(lbl),%tmp_reg
 272                   --                 or    %tmp_reg,%lo(lbl),%target_reg
 273
 274     --  Check the following 3 (checked form CLit on)
 275
 276     CCharLike mode -> if lhs then Cost (0, 0, 0, 1, 0)
 277                              else Cost (0, 0, 1, 0, 0)
 278
 279     CIntLike mode  -> if lhs then Cost (0, 0, 0, 1, 0)
 280                              else Cost (0, 0, 1, 0, 0)
 281
 282     CLit    _      -> if lhs then nullCosts            -- should never occur
 283                              else Cost (1, 0, 0, 0, 0) -- typ.: mov lit,%reg
 284
 285     CJoinPoint _          -> if lhs then Cost (0, 0, 0, 1, 0)
 286                                     else Cost (0, 0, 1, 0, 0)
 287
 288     CMacroExpr _ macro mode_list -> exprMacroCosts side macro mode_list
 289
 290 -- ---------------------------------------------------------------------------
 291
 292 exprMacroCosts :: Side -> CExprMacro -> [CAddrMode] -> CostRes
 293
 294 exprMacroCosts side macro mode_list =
 295   let
 296     arg_costs = foldl (+) nullCosts
 297                       (map (\ x -> addrModeCosts x Rhs) mode_list)
 298   in
 299   arg_costs +
 300   case macro of
 301     ENTRY_CODE -> nullCosts -- nothing
 302     ARG_TAG -> nullCosts -- nothing
 303     GET_TAG -> Cost (0, 0, 1, 0, 0)  -- indirect load
 304     UPD_FRAME_UPDATEE -> Cost (0, 0, 1, 0, 0)  -- indirect load
 305
 306 -- ---------------------------------------------------------------------------
 307
 308 stmtMacroCosts :: CStmtMacro -> [CAddrMode] -> CostRes
 309
 310 stmtMacroCosts macro modes =
 311   case macro of
 312     ARGS_CHK_LOAD_NODE  ->  Cost (2, 1, 0, 0, 0)         {- StgMacros.lh  -}
 313                 -- p=probability of PAP (instead of AP): + p*(3,1,0,0,0)
 314     ARGS_CHK              ->  Cost (2, 1, 0, 0, 0)       {- StgMacros.lh  -}
 315     UPD_CAF               ->  Cost (7, 0, 1, 3, 0)       {- SMupdate.lh  -}
 316     UPD_BH_UPDATABLE      ->  Cost (3, 0, 0, 1, 0)       {- SMupdate.lh  -}
 317     UPD_BH_SINGLE_ENTRY   ->  Cost (3, 0, 0, 1, 0)       {- SMupdate.lh  -}
 318     PUSH_UPD_FRAME        ->  Cost (3, 0, 0, 4, 0)       {- Updates.h    -}
 319     PUSH_SEQ_FRAME        ->  Cost (2, 0, 0, 3, 0)       {- StgMacros.h  !-}
 320     UPDATE_SU_FROM_UPD_FRAME -> Cost (1, 0, 1, 0, 0)     {- StgMacros.h  !-}
 321     SET_TAG               ->  nullCosts             {- COptRegs.lh -}
 322     GRAN_FETCH                  ->  nullCosts     {- GrAnSim bookkeeping -}
 323     GRAN_RESCHEDULE             ->  nullCosts     {- GrAnSim bookkeeping -}
 324     GRAN_FETCH_AND_RESCHEDULE   ->  nullCosts     {- GrAnSim bookkeeping -}
 325     GRAN_YIELD                  ->  nullCosts     {- GrAnSim bookkeeping -- added SOF -}
 326     THREAD_CONTEXT_SWITCH       ->  nullCosts     {- GrAnSim bookkeeping -}
 327     _ -> trace ("Costs.stmtMacroCosts") nullCosts
 328
 329 -- ---------------------------------------------------------------------------
 330
 331 floatOps :: [PrimOp]
 332 floatOps =
 333   [   FloatGtOp  , FloatGeOp  , FloatEqOp  , FloatNeOp  , FloatLtOp  , FloatLeOp
 334     , DoubleGtOp , DoubleGeOp , DoubleEqOp , DoubleNeOp , DoubleLtOp , DoubleLeOp
 335     , FloatAddOp , FloatSubOp , FloatMulOp , FloatDivOp , FloatNegOp
 336     , Float2IntOp , Int2FloatOp
 337     , FloatExpOp   , FloatLogOp   , FloatSqrtOp
 338     , FloatSinOp   , FloatCosOp   , FloatTanOp
 339     , FloatAsinOp  , FloatAcosOp  , FloatAtanOp
 340     , FloatSinhOp  , FloatCoshOp  , FloatTanhOp
 341     , FloatPowerOp
 342     , DoubleAddOp , DoubleSubOp , DoubleMulOp , DoubleDivOp , DoubleNegOp
 343     , Double2IntOp , Int2DoubleOp
 344     , Double2FloatOp , Float2DoubleOp
 345     , DoubleExpOp   , DoubleLogOp   , DoubleSqrtOp
 346     , DoubleSinOp   , DoubleCosOp   , DoubleTanOp
 347     , DoubleAsinOp  , DoubleAcosOp  , DoubleAtanOp
 348     , DoubleSinhOp  , DoubleCoshOp  , DoubleTanhOp
 349     , DoublePowerOp
 350     , FloatDecodeOp
 351     , DoubleDecodeOp
 352   ]
 353
 354 gmpOps :: [PrimOp]
 355 gmpOps  =
 356   [   IntegerAddOp , IntegerSubOp , IntegerMulOp
 357     , IntegerQuotRemOp , IntegerDivModOp
 358     , IntegerCmpOp
 359     , Integer2IntOp  , Int2IntegerOp
 360   ]
 361
 362
 363 umul_costs = Cost (21,4,0,0,0)     -- due to spy counts
 364 rem_costs =  Cost (30,15,0,0,0)    -- due to spy counts
 365 div_costs =  Cost (30,15,0,0,0)    -- due to spy counts
 366
 367
 368
 369 -- ---------------------------------------------------------------------------
 370
 371 opCosts :: StgOp -> CostRes
 372
 373 opCosts (StgFCallOp _ _) = SAVE_COSTS + RESTORE_COSTS
 374         -- Don't guess costs of ccall proper
 375         -- for exact costing use a GRAN_EXEC in the C code
 376
 377 opCosts (StgPrimOp primop)
 378   = primOpCosts primop +
 379     if primOpNeedsWrapper primop then SAVE_COSTS + RESTORE_COSTS
 380                                  else nullCosts
 381
 382 primOpCosts :: PrimOp -> CostRes
 383
 384 -- Usually 3 mov instructions are needed to get args and res in right place.
 385 primOpCosts IntMulOp  = Cost (3, 1, 0, 0, 0)  + umul_costs
 386 primOpCosts IntQuotOp = Cost (3, 1, 0, 0, 0)  + div_costs
 387 primOpCosts IntRemOp  = Cost (3, 1, 0, 0, 0)  + rem_costs
 388 primOpCosts IntNegOp  = Cost (1, 1, 0, 0, 0) -- translates into 1 sub
 389
 390 primOpCosts FloatGtOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 391 primOpCosts FloatGeOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 392 primOpCosts FloatEqOp  = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 393 primOpCosts FloatNeOp  = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 394 primOpCosts FloatLtOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 395 primOpCosts FloatLeOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 396 primOpCosts DoubleGtOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 397 primOpCosts DoubleGeOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 398 primOpCosts DoubleEqOp = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 399 primOpCosts DoubleNeOp = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 400 primOpCosts DoubleLtOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 401 primOpCosts DoubleLeOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 402
 403 primOpCosts FloatExpOp    = Cost (2, 1, 4, 4, 3)
 404 primOpCosts FloatLogOp    = Cost (2, 1, 4, 4, 3)
 405 primOpCosts FloatSqrtOp   = Cost (2, 1, 4, 4, 3)
 406 primOpCosts FloatSinOp    = Cost (2, 1, 4, 4, 3)
 407 primOpCosts FloatCosOp    = Cost (2, 1, 4, 4, 3)
 408 primOpCosts FloatTanOp    = Cost (2, 1, 4, 4, 3)
 409 primOpCosts FloatAsinOp   = Cost (2, 1, 4, 4, 3)
 410 primOpCosts FloatAcosOp   = Cost (2, 1, 4, 4, 3)
 411 primOpCosts FloatAtanOp   = Cost (2, 1, 4, 4, 3)
 412 primOpCosts FloatSinhOp   = Cost (2, 1, 4, 4, 3)
 413 primOpCosts FloatCoshOp   = Cost (2, 1, 4, 4, 3)
 414 primOpCosts FloatTanhOp   = Cost (2, 1, 4, 4, 3)
 415 --primOpCosts FloatAsinhOp  = Cost (2, 1, 4, 4, 3)
 416 --primOpCosts FloatAcoshOp  = Cost (2, 1, 4, 4, 3)
 417 --primOpCosts FloatAtanhOp  = Cost (2, 1, 4, 4, 3)
 418 primOpCosts FloatPowerOp  = Cost (2, 1, 4, 4, 3)
 419
 420 {- There should be special handling of the Array PrimOps in here   HWL -}
 421
 422 primOpCosts primOp
 423   | primOp `elem` floatOps = Cost (0, 0, 0, 0, 1)  :: CostRes
 424   | primOp `elem` gmpOps   = Cost (30, 5, 10, 10, 0) :: CostRes  -- GUESS; check it
 425   | otherwise              = Cost (1, 0, 0, 0, 0)
 426
 427 \end{code}