ghc/compiler/absCSyn/Costs.lhs

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