ghc/compiler/absCSyn/Costs.lhs

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