ghc/compiler/absCSyn/Costs.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 % $Id: Costs.lhs,v 1.33 2003/07/28 16:05:30 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
 305 -- ---------------------------------------------------------------------------
 306
 307 stmtMacroCosts :: CStmtMacro -> [CAddrMode] -> CostRes
 308
 309 stmtMacroCosts macro modes =
 310   case macro of
 311     UPD_CAF               ->  Cost (7, 0, 1, 3, 0)       {- SMupdate.lh  -}
 312     UPD_BH_UPDATABLE      ->  Cost (3, 0, 0, 1, 0)       {- SMupdate.lh  -}
 313     UPD_BH_SINGLE_ENTRY   ->  Cost (3, 0, 0, 1, 0)       {- SMupdate.lh  -}
 314     PUSH_UPD_FRAME        ->  Cost (3, 0, 0, 4, 0)       {- Updates.h    -}
 315     SET_TAG               ->  nullCosts             {- COptRegs.lh -}
 316     GRAN_FETCH                  ->  nullCosts     {- GrAnSim bookkeeping -}
 317     GRAN_RESCHEDULE             ->  nullCosts     {- GrAnSim bookkeeping -}
 318     GRAN_FETCH_AND_RESCHEDULE   ->  nullCosts     {- GrAnSim bookkeeping -}
 319     GRAN_YIELD                  ->  nullCosts     {- GrAnSim bookkeeping -- added SOF -}
 320     THREAD_CONTEXT_SWITCH       ->  nullCosts     {- GrAnSim bookkeeping -}
 321     _ -> trace ("Costs.stmtMacroCosts") nullCosts
 322
 323 -- ---------------------------------------------------------------------------
 324
 325 floatOps :: [PrimOp]
 326 floatOps =
 327   [   FloatGtOp  , FloatGeOp  , FloatEqOp  , FloatNeOp  , FloatLtOp  , FloatLeOp
 328     , DoubleGtOp , DoubleGeOp , DoubleEqOp , DoubleNeOp , DoubleLtOp , DoubleLeOp
 329     , FloatAddOp , FloatSubOp , FloatMulOp , FloatDivOp , FloatNegOp
 330     , Float2IntOp , Int2FloatOp
 331     , FloatExpOp   , FloatLogOp   , FloatSqrtOp
 332     , FloatSinOp   , FloatCosOp   , FloatTanOp
 333     , FloatAsinOp  , FloatAcosOp  , FloatAtanOp
 334     , FloatSinhOp  , FloatCoshOp  , FloatTanhOp
 335     , FloatPowerOp
 336     , DoubleAddOp , DoubleSubOp , DoubleMulOp , DoubleDivOp , DoubleNegOp
 337     , Double2IntOp , Int2DoubleOp
 338     , Double2FloatOp , Float2DoubleOp
 339     , DoubleExpOp   , DoubleLogOp   , DoubleSqrtOp
 340     , DoubleSinOp   , DoubleCosOp   , DoubleTanOp
 341     , DoubleAsinOp  , DoubleAcosOp  , DoubleAtanOp
 342     , DoubleSinhOp  , DoubleCoshOp  , DoubleTanhOp
 343     , DoublePowerOp
 344     , FloatDecodeOp
 345     , DoubleDecodeOp
 346   ]
 347
 348 gmpOps :: [PrimOp]
 349 gmpOps  =
 350   [   IntegerAddOp , IntegerSubOp , IntegerMulOp
 351     , IntegerQuotRemOp , IntegerDivModOp
 352     , IntegerCmpOp
 353     , Integer2IntOp  , Int2IntegerOp
 354   ]
 355
 356
 357 umul_costs = Cost (21,4,0,0,0)     -- due to spy counts
 358 rem_costs =  Cost (30,15,0,0,0)    -- due to spy counts
 359 div_costs =  Cost (30,15,0,0,0)    -- due to spy counts
 360
 361
 362
 363 -- ---------------------------------------------------------------------------
 364
 365 opCosts :: StgOp -> CostRes
 366
 367 opCosts (StgFCallOp _ _) = SAVE_COSTS + RESTORE_COSTS
 368         -- Don't guess costs of ccall proper
 369         -- for exact costing use a GRAN_EXEC in the C code
 370
 371 opCosts (StgPrimOp primop)
 372   = primOpCosts primop +
 373     if primOpNeedsWrapper primop then SAVE_COSTS + RESTORE_COSTS
 374                                  else nullCosts
 375
 376 primOpCosts :: PrimOp -> CostRes
 377
 378 -- Usually 3 mov instructions are needed to get args and res in right place.
 379 primOpCosts IntMulOp  = Cost (3, 1, 0, 0, 0)  + umul_costs
 380 primOpCosts IntQuotOp = Cost (3, 1, 0, 0, 0)  + div_costs
 381 primOpCosts IntRemOp  = Cost (3, 1, 0, 0, 0)  + rem_costs
 382 primOpCosts IntNegOp  = Cost (1, 1, 0, 0, 0) -- translates into 1 sub
 383
 384 primOpCosts FloatGtOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 385 primOpCosts FloatGeOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 386 primOpCosts FloatEqOp  = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 387 primOpCosts FloatNeOp  = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 388 primOpCosts FloatLtOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 389 primOpCosts FloatLeOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 390 primOpCosts DoubleGtOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 391 primOpCosts DoubleGeOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 392 primOpCosts DoubleEqOp = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 393 primOpCosts DoubleNeOp = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 394 primOpCosts DoubleLtOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 395 primOpCosts DoubleLeOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 396
 397 primOpCosts FloatExpOp    = Cost (2, 1, 4, 4, 3)
 398 primOpCosts FloatLogOp    = Cost (2, 1, 4, 4, 3)
 399 primOpCosts FloatSqrtOp   = Cost (2, 1, 4, 4, 3)
 400 primOpCosts FloatSinOp    = Cost (2, 1, 4, 4, 3)
 401 primOpCosts FloatCosOp    = Cost (2, 1, 4, 4, 3)
 402 primOpCosts FloatTanOp    = Cost (2, 1, 4, 4, 3)
 403 primOpCosts FloatAsinOp   = Cost (2, 1, 4, 4, 3)
 404 primOpCosts FloatAcosOp   = Cost (2, 1, 4, 4, 3)
 405 primOpCosts FloatAtanOp   = Cost (2, 1, 4, 4, 3)
 406 primOpCosts FloatSinhOp   = Cost (2, 1, 4, 4, 3)
 407 primOpCosts FloatCoshOp   = Cost (2, 1, 4, 4, 3)
 408 primOpCosts FloatTanhOp   = Cost (2, 1, 4, 4, 3)
 409 --primOpCosts FloatAsinhOp  = Cost (2, 1, 4, 4, 3)
 410 --primOpCosts FloatAcoshOp  = Cost (2, 1, 4, 4, 3)
 411 --primOpCosts FloatAtanhOp  = Cost (2, 1, 4, 4, 3)
 412 primOpCosts FloatPowerOp  = Cost (2, 1, 4, 4, 3)
 413
 414 {- There should be special handling of the Array PrimOps in here   HWL -}
 415
 416 primOpCosts primOp
 417   | primOp `elem` floatOps = Cost (0, 0, 0, 0, 1)  :: CostRes
 418   | primOp `elem` gmpOps   = Cost (30, 5, 10, 10, 0) :: CostRes  -- GUESS; check it
 419   | otherwise              = Cost (1, 0, 0, 0, 0)
 420
 421 \end{code}