ghc/compiler/absCSyn/Costs.lhs

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