ghc/compiler/absCSyn/Costs.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 % $Id: Costs.lhs,v 1.24 2000/07/06 14:08:31 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     CJoinPoint _          -> if lhs then Cost (0, 0, 0, 1, 0)
 293                                     else Cost (0, 0, 1, 0, 0)
 294
 295     CMacroExpr _ macro mode_list -> exprMacroCosts side macro mode_list
 296
 297 -- ---------------------------------------------------------------------------
 298
 299 exprMacroCosts :: Side -> CExprMacro -> [CAddrMode] -> CostRes
 300
 301 exprMacroCosts side macro mode_list =
 302   let
 303     arg_costs = foldl (+) nullCosts
 304                       (map (\ x -> addrModeCosts x Rhs) mode_list)
 305   in
 306   arg_costs +
 307   case macro of
 308     ENTRY_CODE -> nullCosts -- nothing
 309     ARG_TAG -> nullCosts -- nothing
 310     GET_TAG -> Cost (0, 0, 1, 0, 0)  -- indirect load
 311     UPD_FRAME_UPDATEE -> Cost (0, 0, 1, 0, 0)  -- indirect load
 312
 313 -- ---------------------------------------------------------------------------
 314
 315 stmtMacroCosts :: CStmtMacro -> [CAddrMode] -> CostRes
 316
 317 stmtMacroCosts macro modes =
 318   let
 319     arg_costs =   foldl (+) nullCosts
 320                         [addrModeCosts mode Rhs | mode <- modes]
 321   in
 322   case macro of
 323     ARGS_CHK_LOAD_NODE  ->  Cost (2, 1, 0, 0, 0)         {- StgMacros.lh  -}
 324                 -- p=probability of PAP (instead of AP): + p*(3,1,0,0,0)
 325     ARGS_CHK              ->  Cost (2, 1, 0, 0, 0)       {- StgMacros.lh  -}
 326     UPD_CAF               ->  Cost (7, 0, 1, 3, 0)       {- SMupdate.lh  -}
 327     UPD_BH_UPDATABLE      ->  Cost (3, 0, 0, 1, 0)       {- SMupdate.lh  -}
 328     UPD_BH_SINGLE_ENTRY   ->  Cost (3, 0, 0, 1, 0)       {- SMupdate.lh  -}
 329     PUSH_UPD_FRAME        ->  Cost (3, 0, 0, 4, 0)       {- Updates.h    -}
 330     PUSH_SEQ_FRAME        ->  Cost (2, 0, 0, 3, 0)       {- StgMacros.h  !-}
 331     UPDATE_SU_FROM_UPD_FRAME -> Cost (1, 0, 1, 0, 0)     {- StgMacros.h  !-}
 332     SET_TAG               ->  nullCosts             {- COptRegs.lh -}
 333     GRAN_FETCH                  ->  nullCosts     {- GrAnSim bookkeeping -}
 334     GRAN_RESCHEDULE             ->  nullCosts     {- GrAnSim bookkeeping -}
 335     GRAN_FETCH_AND_RESCHEDULE   ->  nullCosts     {- GrAnSim bookkeeping -}
 336     GRAN_YIELD                  ->  nullCosts     {- GrAnSim bookkeeping -- added SOF -}
 337     THREAD_CONTEXT_SWITCH       ->  nullCosts     {- GrAnSim bookkeeping -}
 338     _ -> trace ("Costs.stmtMacroCosts") nullCosts
 339
 340 -- ---------------------------------------------------------------------------
 341
 342 floatOps :: [PrimOp]
 343 floatOps =
 344   [   FloatGtOp  , FloatGeOp  , FloatEqOp  , FloatNeOp  , FloatLtOp  , FloatLeOp
 345     , DoubleGtOp , DoubleGeOp , DoubleEqOp , DoubleNeOp , DoubleLtOp , DoubleLeOp
 346     , FloatAddOp , FloatSubOp , FloatMulOp , FloatDivOp , FloatNegOp
 347     , Float2IntOp , Int2FloatOp
 348     , FloatExpOp   , FloatLogOp   , FloatSqrtOp
 349     , FloatSinOp   , FloatCosOp   , FloatTanOp
 350     , FloatAsinOp  , FloatAcosOp  , FloatAtanOp
 351     , FloatSinhOp  , FloatCoshOp  , FloatTanhOp
 352     , FloatPowerOp
 353     , DoubleAddOp , DoubleSubOp , DoubleMulOp , DoubleDivOp , DoubleNegOp
 354     , Double2IntOp , Int2DoubleOp
 355     , Double2FloatOp , Float2DoubleOp
 356     , DoubleExpOp   , DoubleLogOp   , DoubleSqrtOp
 357     , DoubleSinOp   , DoubleCosOp   , DoubleTanOp
 358     , DoubleAsinOp  , DoubleAcosOp  , DoubleAtanOp
 359     , DoubleSinhOp  , DoubleCoshOp  , DoubleTanhOp
 360     , DoublePowerOp
 361     , FloatDecodeOp
 362     , DoubleDecodeOp
 363   ]
 364
 365 gmpOps :: [PrimOp]
 366 gmpOps  =
 367   [   IntegerAddOp , IntegerSubOp , IntegerMulOp
 368     , IntegerQuotRemOp , IntegerDivModOp , IntegerNegOp
 369     , IntegerCmpOp
 370     , Integer2IntOp  , Int2IntegerOp
 371     , Addr2IntegerOp
 372   ]
 373
 374
 375 abs_costs = nullCosts   -- NB:  This is normal STG code with costs already
 376                         --      included; no need to add costs again.
 377
 378 umul_costs = Cost (21,4,0,0,0)     -- due to spy counts
 379 rem_costs =  Cost (30,15,0,0,0)    -- due to spy counts
 380 div_costs =  Cost (30,15,0,0,0)    -- due to spy counts
 381
 382 primOpCosts :: PrimOp -> CostRes
 383
 384 -- Special cases
 385
 386 primOpCosts (CCallOp _) = SAVE_COSTS + RESTORE_COSTS
 387                                   -- don't guess costs of ccall proper
 388                                   -- for exact costing use a GRAN_EXEC
 389                                   -- in the C code
 390
 391 -- Usually 3 mov instructions are needed to get args and res in right place.
 392
 393 primOpCosts IntMulOp  = Cost (3, 1, 0, 0, 0)  + umul_costs
 394 primOpCosts IntQuotOp = Cost (3, 1, 0, 0, 0)  + div_costs
 395 primOpCosts IntRemOp  = Cost (3, 1, 0, 0, 0)  + rem_costs
 396 primOpCosts IntNegOp  = Cost (1, 1, 0, 0, 0) -- translates into 1 sub
 397
 398 primOpCosts FloatGtOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 399 primOpCosts FloatGeOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 400 primOpCosts FloatEqOp  = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 401 primOpCosts FloatNeOp  = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 402 primOpCosts FloatLtOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 403 primOpCosts FloatLeOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 404 primOpCosts DoubleGtOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 405 primOpCosts DoubleGeOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 406 primOpCosts DoubleEqOp = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 407 primOpCosts DoubleNeOp = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 408 primOpCosts DoubleLtOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 409 primOpCosts DoubleLeOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 410
 411 primOpCosts FloatExpOp    = Cost (2, 1, 4, 4, 3)
 412 primOpCosts FloatLogOp    = Cost (2, 1, 4, 4, 3)
 413 primOpCosts FloatSqrtOp   = Cost (2, 1, 4, 4, 3)
 414 primOpCosts FloatSinOp    = Cost (2, 1, 4, 4, 3)
 415 primOpCosts FloatCosOp    = Cost (2, 1, 4, 4, 3)
 416 primOpCosts FloatTanOp    = Cost (2, 1, 4, 4, 3)
 417 primOpCosts FloatAsinOp   = Cost (2, 1, 4, 4, 3)
 418 primOpCosts FloatAcosOp   = Cost (2, 1, 4, 4, 3)
 419 primOpCosts FloatAtanOp   = Cost (2, 1, 4, 4, 3)
 420 primOpCosts FloatSinhOp   = Cost (2, 1, 4, 4, 3)
 421 primOpCosts FloatCoshOp   = Cost (2, 1, 4, 4, 3)
 422 primOpCosts FloatTanhOp   = Cost (2, 1, 4, 4, 3)
 423 --primOpCosts FloatAsinhOp  = Cost (2, 1, 4, 4, 3)
 424 --primOpCosts FloatAcoshOp  = Cost (2, 1, 4, 4, 3)
 425 --primOpCosts FloatAtanhOp  = Cost (2, 1, 4, 4, 3)
 426 primOpCosts FloatPowerOp  = Cost (2, 1, 4, 4, 3)
 427
 428 {- There should be special handling of the Array PrimOps in here   HWL -}
 429
 430 primOpCosts primOp
 431   | primOp `elem` floatOps = Cost (0, 0, 0, 0, 1)  :: CostRes
 432   | primOp `elem` gmpOps   = Cost (30, 5, 10, 10, 0) :: CostRes  -- GUESS; check it
 433   | otherwise              = Cost (1, 0, 0, 0, 0)
 434
 435 -- ---------------------------------------------------------------------------
 436 {- HWL: currently unused
 437
 438 costsByKind :: PrimRep -> Side -> CostRes
 439
 440 -- The following PrimKinds say that the data is already in a reg
 441
 442 costsByKind CharRep     _ = nullCosts
 443 costsByKind IntRep      _ = nullCosts
 444 costsByKind WordRep     _ = nullCosts
 445 costsByKind AddrRep     _ = nullCosts
 446 costsByKind FloatRep    _ = nullCosts
 447 costsByKind DoubleRep   _ = nullCosts
 448 -}
 449 -- ---------------------------------------------------------------------------
 450 \end{code}