ghc/compiler/absCSyn/Costs.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 % $Id: Costs.lhs,v 1.22 2000/04/10 13:59:17 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 PrimOp           ( primOpNeedsWrapper, PrimOp(..) )
  66 import Panic            ( trace )
  67
  68 -- --------------------------------------------------------------------------
  69 data CostRes = Cost (Int, Int, Int, Int, Int)
  70                deriving (Show)
  71
  72 nullCosts    = Cost (0, 0, 0, 0, 0) :: CostRes
  73 initHdrCosts = Cost (2, 0, 0, 1, 0) :: CostRes
  74 errorCosts   = Cost (-1, -1, -1, -1, -1)  -- just for debugging
  75
  76 oneArithm = Cost (1, 0, 0, 0, 0) :: CostRes
  77
  78 instance Eq CostRes where
  79  (==) t1 t2 = i && b && l && s && f
  80              where (i,b,l,s,f) = binOp' (==) t1 t2
  81
  82 instance Num CostRes where
  83  (+) = binOp (+)
  84  (-) = binOp (-)
  85  (*) = binOp (*)
  86  negate  = mapOp negate
  87  abs     = mapOp abs
  88  signum  = mapOp signum
  89  fromInteger _ = error "fromInteger not defined"
  90
  91 mapOp :: (Int -> Int) -> CostRes -> CostRes
  92 mapOp g ( Cost (i, b, l, s, f) )  = Cost (g i, g b, g l, g s, g f)
  93
  94 foldrOp :: (Int -> a -> a) -> a -> CostRes -> a
  95 foldrOp o x  ( Cost (i1, b1, l1, s1, f1) )   =
  96         i1 `o` ( b1 `o` ( l1 `o` ( s1 `o` ( f1 `o` x))))
  97
  98 binOp :: (Int -> Int -> Int) -> CostRes -> CostRes -> CostRes
  99 binOp o ( Cost (i1, b1, l1, s1, f1) ) ( Cost  (i2, b2, l2, s2, f2) )  =
 100         ( Cost (i1 `o` i2, b1 `o` b2, l1 `o` l2, s1 `o` s2, f1 `o` f2) )
 101
 102 binOp' :: (Int -> Int -> a) -> CostRes -> CostRes -> (a,a,a,a,a)
 103 binOp' o ( Cost (i1, b1, l1, s1, f1) ) ( Cost  (i2, b2, l2, s2, f2) )  =
 104          (i1 `o` i2, b1 `o` b2, l1 `o` l2, s1 `o` s2, f1 `o` f2)
 105
 106 -- --------------------------------------------------------------------------
 107
 108 data Side = Lhs | Rhs
 109             deriving (Eq)
 110
 111 -- --------------------------------------------------------------------------
 112
 113 costs :: AbstractC -> CostRes
 114
 115 costs absC =
 116   case absC of
 117    AbsCNop                      ->  nullCosts
 118
 119    AbsCStmts absC1 absC2        -> costs absC1 + costs absC2
 120
 121    CAssign (CReg _) (CReg _)    -> Cost (1,0,0,0,0)   -- typ.: mov %reg1,%reg2
 122
 123    CAssign (CReg _) (CTemp _ _) -> Cost (1,0,0,0,0)
 124
 125    CAssign (CReg _) source_m    -> addrModeCosts source_m Rhs
 126
 127    CAssign target_m source_m    -> addrModeCosts target_m Lhs +
 128                                    addrModeCosts source_m Rhs
 129
 130    CJump (CLbl _  _)            -> Cost (0,1,0,0,0)  -- no ld for call necessary
 131
 132    CJump mode                   -> addrModeCosts mode Rhs +
 133                                    Cost (0,1,0,0,0)
 134
 135    CFallThrough mode  -> addrModeCosts mode Rhs +               -- chu' 0.24
 136                          Cost (0,1,0,0,0)
 137
 138    CReturn mode info  -> case info of
 139                           DirectReturn -> addrModeCosts mode Rhs +
 140                                           Cost (0,1,0,0,0)
 141
 142                             -- i.e. ld address to reg and call reg
 143
 144                           DynamicVectoredReturn mode' ->
 145                                         addrModeCosts mode Rhs +
 146                                         addrModeCosts mode' Rhs +
 147                                         Cost (0,1,1,0,0)
 148
 149                             {- generates code like this:
 150                                 JMP_(<mode>)[RVREL(<mode'>)];
 151                                i.e. 1 possb ld for mode'
 152                                     1 ld for RVREL
 153                                     1 possb ld for mode
 154                                     1 call                              -}
 155
 156                           StaticVectoredReturn _ -> addrModeCosts mode Rhs +
 157                                                   Cost (0,1,1,0,0)
 158
 159                             -- as above with mode' fixed to CLit
 160                             -- typically 2 ld + 1 call; 1st ld due
 161                             -- to CVal as mode
 162
 163    CSwitch mode alts absC     -> nullCosts
 164                                  {- for handling costs of all branches of
 165                                     a CSwitch see PprAbsC.
 166                                     Basically:
 167                                      Costs for branch =
 168                                         Costs before CSwitch +
 169                                         addrModeCosts of head +
 170                                         Costs for 1 cond branch +
 171                                         Costs for body of branch
 172                                  -}
 173
 174    CCodeBlock _ absC          -> costs absC
 175
 176    CInitHdr cl_info reg_rel cost_centre -> initHdrCosts
 177
 178                         {- This is more fancy but superflous: The addr modes
 179                            are fixed and so the costs are const!
 180
 181                         argCosts + initHdrCosts
 182                         where argCosts = addrModeCosts (CAddr reg_rel) Rhs +
 183                                          addrModeCosts base_lbl +    -- CLbl!
 184                                          3*addrModeCosts (mkIntCLit 1{- any val -})
 185                         -}
 186                         {- this extends to something like
 187                             SET_SPEC_HDR(...)
 188                            For costing the args of this macro
 189                            see PprAbsC.lhs where args are inserted -}
 190
 191    COpStmt modes_res primOp modes_args _ ->
 192         {-
 193            let
 194                 n = length modes_res
 195            in
 196                 (0, 0, n, n, 0) +
 197                 primOpCosts primOp +
 198                 if primOpNeedsWrapper primOp then SAVE_COSTS + RESTORE_COSTS
 199                                              else nullCosts
 200            -- ^^HWL
 201         -}
 202         foldl (+) nullCosts [addrModeCosts mode Lhs | mode <- modes_res]  +
 203         foldl (+) nullCosts [addrModeCosts mode Rhs | mode <- modes_args]  +
 204         primOpCosts primOp +
 205         if primOpNeedsWrapper primOp then SAVE_COSTS + RESTORE_COSTS
 206                                      else nullCosts
 207
 208    CSimultaneous absC        -> costs absC
 209
 210    CCheck _ amodes code      -> Cost (2, 1, 0, 0, 0) -- ToDo: refine this by
 211                                                      -- looking at the first arg
 212
 213    CRetDirect _ _ _ _        -> nullCosts
 214
 215    CMacroStmt   macro modes  -> stmtMacroCosts macro modes
 216
 217    CCallProfCtrMacro   _ _   -> nullCosts
 218                                   {- we don't count profiling in GrAnSim -}
 219
 220    CCallProfCCMacro    _ _   -> nullCosts
 221                                   {- we don't count profiling in GrAnSim -}
 222
 223   -- *** the next three [or so...] are DATA (those above are CODE) ***
 224   -- as they are data rather than code they all have nullCosts         -- HWL
 225
 226    CCallTypedef _ _ _ _      -> nullCosts
 227
 228    CStaticClosure _ _ _ _    -> nullCosts
 229
 230    CSRT _ _                  -> nullCosts
 231
 232    CBitmap _ _               -> nullCosts
 233
 234    CClosureInfoAndCode _ _ _ _ -> nullCosts
 235
 236    CRetVector _ _ _ _        -> nullCosts
 237
 238    CClosureTbl _             -> nullCosts
 239
 240    CCostCentreDecl _ _       -> nullCosts
 241
 242    CCostCentreStackDecl _    -> nullCosts
 243
 244    CSplitMarker              -> nullCosts
 245
 246    _ -> trace ("Costs.costs") nullCosts
 247
 248 -- ---------------------------------------------------------------------------
 249
 250 addrModeCosts :: CAddrMode -> Side -> CostRes
 251
 252 -- addrModeCosts _ _ = nullCosts
 253
 254 addrModeCosts addr_mode side =
 255   let
 256     lhs = side == Lhs
 257   in
 258   case addr_mode of
 259     CVal _ _ -> if lhs then Cost (0, 0, 0, 1, 0)
 260                        else Cost (0, 0, 1, 0, 0)
 261
 262     CAddr (CIndex _ n _ ) -> Cost (1, 0, 1, 0, 0) -- does pointer arithmetic
 263
 264     CAddr _ -> nullCosts
 265
 266     CReg _  -> nullCosts         {- loading from, storing to reg is free ! -}
 267                                  {- for costing CReg->Creg ops see special -}
 268                                  {- case in costs fct -}
 269
 270     CTemp _ _  -> nullCosts     {- if lhs then Cost (0, 0, 0, 1, 0)
 271                                           else Cost (0, 0, 1, 0, 0)  -}
 272         -- ``Temporaries'' correspond to local variables in C, and registers in
 273         -- native code.
 274         -- I assume they can be somewhat optimized by gcc -- HWL
 275
 276     CLbl _ _   -> if lhs then Cost (0, 0, 0, 1, 0)
 277                          else Cost (2, 0, 0, 0, 0)
 278                   -- Rhs: typically: sethi %hi(lbl),%tmp_reg
 279                   --                 or    %tmp_reg,%lo(lbl),%target_reg
 280
 281     --  Check the following 3 (checked form CLit on)
 282
 283     CCharLike mode -> if lhs then Cost (0, 0, 0, 1, 0)
 284                              else Cost (0, 0, 1, 0, 0)
 285
 286     CIntLike mode  -> if lhs then Cost (0, 0, 0, 1, 0)
 287                              else Cost (0, 0, 1, 0, 0)
 288
 289     CLit    _      -> if lhs then nullCosts            -- should never occur
 290                              else Cost (1, 0, 0, 0, 0) -- typ.: mov lit,%reg
 291
 292     CLitLit _  _   -> if lhs then nullCosts
 293                              else Cost (1, 0, 0, 0, 0)
 294                       -- same es CLit
 295
 296     CJoinPoint _          -> if lhs then Cost (0, 0, 0, 1, 0)
 297                                     else Cost (0, 0, 1, 0, 0)
 298
 299     CMacroExpr _ macro mode_list -> exprMacroCosts side macro mode_list
 300
 301     _ -> trace ("Costs.addrModeCosts") nullCosts
 302
 303 -- ---------------------------------------------------------------------------
 304
 305 exprMacroCosts :: Side -> CExprMacro -> [CAddrMode] -> CostRes
 306
 307 exprMacroCosts side macro mode_list =
 308   let
 309     arg_costs = foldl (+) nullCosts
 310                       (map (\ x -> addrModeCosts x Rhs) mode_list)
 311   in
 312   arg_costs +
 313   case macro of
 314     ENTRY_CODE -> nullCosts -- nothing
 315     ARG_TAG -> nullCosts -- nothing
 316     GET_TAG -> Cost (0, 0, 1, 0, 0)  -- indirect load
 317     UPD_FRAME_UPDATEE -> Cost (0, 0, 1, 0, 0)  -- indirect load
 318     _ -> trace ("Costs.exprMacroCosts") nullCosts
 319
 320 -- ---------------------------------------------------------------------------
 321
 322 stmtMacroCosts :: CStmtMacro -> [CAddrMode] -> CostRes
 323
 324 stmtMacroCosts macro modes =
 325   let
 326     arg_costs =   foldl (+) nullCosts
 327                         [addrModeCosts mode Rhs | mode <- modes]
 328   in
 329   case macro of
 330     ARGS_CHK_LOAD_NODE  ->  Cost (2, 1, 0, 0, 0)         {- StgMacros.lh  -}
 331                 -- p=probability of PAP (instead of AP): + p*(3,1,0,0,0)
 332     ARGS_CHK              ->  Cost (2, 1, 0, 0, 0)       {- StgMacros.lh  -}
 333     UPD_CAF               ->  Cost (7, 0, 1, 3, 0)       {- SMupdate.lh  -}
 334     UPD_BH_UPDATABLE      ->  Cost (3, 0, 0, 1, 0)       {- SMupdate.lh  -}
 335     UPD_BH_SINGLE_ENTRY   ->  Cost (3, 0, 0, 1, 0)       {- SMupdate.lh  -}
 336     PUSH_UPD_FRAME        ->  Cost (3, 0, 0, 4, 0)       {- Updates.h    -}
 337     PUSH_SEQ_FRAME        ->  Cost (2, 0, 0, 3, 0)       {- StgMacros.h  !-}
 338     UPDATE_SU_FROM_UPD_FRAME -> Cost (1, 0, 1, 0, 0)     {- StgMacros.h  !-}
 339     SET_TAG               ->  nullCosts             {- COptRegs.lh -}
 340     GRAN_FETCH                  ->  nullCosts     {- GrAnSim bookkeeping -}
 341     GRAN_RESCHEDULE             ->  nullCosts     {- GrAnSim bookkeeping -}
 342     GRAN_FETCH_AND_RESCHEDULE   ->  nullCosts     {- GrAnSim bookkeeping -}
 343     GRAN_YIELD                  ->  nullCosts     {- GrAnSim bookkeeping -- added SOF -}
 344     THREAD_CONTEXT_SWITCH       ->  nullCosts     {- GrAnSim bookkeeping -}
 345     _ -> trace ("Costs.stmtMacroCosts") nullCosts
 346
 347 -- ---------------------------------------------------------------------------
 348
 349 floatOps :: [PrimOp]
 350 floatOps =
 351   [   FloatGtOp  , FloatGeOp  , FloatEqOp  , FloatNeOp  , FloatLtOp  , FloatLeOp
 352     , DoubleGtOp , DoubleGeOp , DoubleEqOp , DoubleNeOp , DoubleLtOp , DoubleLeOp
 353     , FloatAddOp , FloatSubOp , FloatMulOp , FloatDivOp , FloatNegOp
 354     , Float2IntOp , Int2FloatOp
 355     , FloatExpOp   , FloatLogOp   , FloatSqrtOp
 356     , FloatSinOp   , FloatCosOp   , FloatTanOp
 357     , FloatAsinOp  , FloatAcosOp  , FloatAtanOp
 358     , FloatSinhOp  , FloatCoshOp  , FloatTanhOp
 359     , FloatPowerOp
 360     , DoubleAddOp , DoubleSubOp , DoubleMulOp , DoubleDivOp , DoubleNegOp
 361     , Double2IntOp , Int2DoubleOp
 362     , Double2FloatOp , Float2DoubleOp
 363     , DoubleExpOp   , DoubleLogOp   , DoubleSqrtOp
 364     , DoubleSinOp   , DoubleCosOp   , DoubleTanOp
 365     , DoubleAsinOp  , DoubleAcosOp  , DoubleAtanOp
 366     , DoubleSinhOp  , DoubleCoshOp  , DoubleTanhOp
 367     , DoublePowerOp
 368     , FloatDecodeOp
 369     , DoubleDecodeOp
 370   ]
 371
 372 gmpOps :: [PrimOp]
 373 gmpOps  =
 374   [   IntegerAddOp , IntegerSubOp , IntegerMulOp
 375     , IntegerQuotRemOp , IntegerDivModOp , IntegerNegOp
 376     , IntegerCmpOp
 377     , Integer2IntOp  , Int2IntegerOp
 378     , Addr2IntegerOp
 379   ]
 380
 381
 382 abs_costs = nullCosts   -- NB:  This is normal STG code with costs already
 383                         --      included; no need to add costs again.
 384
 385 umul_costs = Cost (21,4,0,0,0)     -- due to spy counts
 386 rem_costs =  Cost (30,15,0,0,0)    -- due to spy counts
 387 div_costs =  Cost (30,15,0,0,0)    -- due to spy counts
 388
 389 primOpCosts :: PrimOp -> CostRes
 390
 391 -- Special cases
 392
 393 primOpCosts (CCallOp _) = SAVE_COSTS + RESTORE_COSTS
 394                                   -- don't guess costs of ccall proper
 395                                   -- for exact costing use a GRAN_EXEC
 396                                   -- in the C code
 397
 398 -- Usually 3 mov instructions are needed to get args and res in right place.
 399
 400 primOpCosts IntMulOp  = Cost (3, 1, 0, 0, 0)  + umul_costs
 401 primOpCosts IntQuotOp = Cost (3, 1, 0, 0, 0)  + div_costs
 402 primOpCosts IntRemOp  = Cost (3, 1, 0, 0, 0)  + rem_costs
 403 primOpCosts IntNegOp  = Cost (1, 1, 0, 0, 0) -- translates into 1 sub
 404
 405 primOpCosts FloatGtOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 406 primOpCosts FloatGeOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 407 primOpCosts FloatEqOp  = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 408 primOpCosts FloatNeOp  = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 409 primOpCosts FloatLtOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 410 primOpCosts FloatLeOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 411 primOpCosts DoubleGtOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 412 primOpCosts DoubleGeOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 413 primOpCosts DoubleEqOp = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 414 primOpCosts DoubleNeOp = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 415 primOpCosts DoubleLtOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 416 primOpCosts DoubleLeOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 417
 418 primOpCosts FloatExpOp    = Cost (2, 1, 4, 4, 3)
 419 primOpCosts FloatLogOp    = Cost (2, 1, 4, 4, 3)
 420 primOpCosts FloatSqrtOp   = Cost (2, 1, 4, 4, 3)
 421 primOpCosts FloatSinOp    = Cost (2, 1, 4, 4, 3)
 422 primOpCosts FloatCosOp    = Cost (2, 1, 4, 4, 3)
 423 primOpCosts FloatTanOp    = Cost (2, 1, 4, 4, 3)
 424 primOpCosts FloatAsinOp   = Cost (2, 1, 4, 4, 3)
 425 primOpCosts FloatAcosOp   = Cost (2, 1, 4, 4, 3)
 426 primOpCosts FloatAtanOp   = Cost (2, 1, 4, 4, 3)
 427 primOpCosts FloatSinhOp   = Cost (2, 1, 4, 4, 3)
 428 primOpCosts FloatCoshOp   = Cost (2, 1, 4, 4, 3)
 429 primOpCosts FloatTanhOp   = Cost (2, 1, 4, 4, 3)
 430 --primOpCosts FloatAsinhOp  = Cost (2, 1, 4, 4, 3)
 431 --primOpCosts FloatAcoshOp  = Cost (2, 1, 4, 4, 3)
 432 --primOpCosts FloatAtanhOp  = Cost (2, 1, 4, 4, 3)
 433 primOpCosts FloatPowerOp  = Cost (2, 1, 4, 4, 3)
 434
 435 {- There should be special handling of the Array PrimOps in here   HWL -}
 436
 437 primOpCosts primOp
 438   | primOp `elem` floatOps = Cost (0, 0, 0, 0, 1)  :: CostRes
 439   | primOp `elem` gmpOps   = Cost (30, 5, 10, 10, 0) :: CostRes  -- GUESS; check it
 440   | otherwise              = Cost (1, 0, 0, 0, 0)
 441
 442 -- ---------------------------------------------------------------------------
 443 {- HWL: currently unused
 444
 445 costsByKind :: PrimRep -> Side -> CostRes
 446
 447 -- The following PrimKinds say that the data is already in a reg
 448
 449 costsByKind CharRep     _ = nullCosts
 450 costsByKind IntRep      _ = nullCosts
 451 costsByKind WordRep     _ = nullCosts
 452 costsByKind AddrRep     _ = nullCosts
 453 costsByKind FloatRep    _ = nullCosts
 454 costsByKind DoubleRep   _ = nullCosts
 455 -}
 456 -- ---------------------------------------------------------------------------
 457 \end{code}