ghc/compiler/absCSyn/Costs.lhs

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