ghc/compiler/absCSyn/Costs.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1994-1995
   3 %     Hans Wolfgang Loidl
   4 %
   5 % ---------------------------------------------------------------------------
   6
   7 \section[Costs]{Evaluating the costs of computing some abstract C code}
   8
   9 This module   provides all necessary  functions for   computing for a given
  10 abstract~C Program the costs of executing that program. This is done by the
  11 exported function:
  12
  13 \begin{quote}
  14  {\verb type CostRes = (Int, Int, Int, Int, Int)}
  15  {\verb costs :: AbstractC -> CostRes }
  16 \end{quote}
  17
  18 The meaning of the result tuple is:
  19 \begin{itemize}
  20  \item The first component ({\tt i}) counts the number of integer,
  21    arithmetic and bit-manipulating instructions.
  22  \item The second component ({\tt b}) counts the number of branches (direct
  23    branches as well as indirect ones).
  24  \item The third component ({\tt l}) counts the number of load instructions.
  25  \item The fourth component ({\tt s}) counts the number of store
  26    instructions.
  27  \item The fifth component ({\tt f}) counts the number of floating point
  28    instructions.
  29 \end{itemize}
  30
  31 This function is needed in GrAnSim for parallelism.
  32
  33 These are first suggestions for scaling the costs. But, this scaling should be done in the RTS rather than the compiler (this really should be tunable!):
  34
  35 \begin{pseudocode}
  36
  37 #define LOAD_COSTS              2
  38 #define STORE_COSTS             2
  39 #define INT_ARITHM_COSTS        1
  40 #define GMP_ARITHM_COSTS        3 {- any clue for GMP costs ? -}
  41 #define FLOAT_ARITHM_COSTS      3 {- any clue for float costs ? -}
  42 #define BRANCH_COSTS            2
  43
  44 \end{pseudocode}
  45
  46 \begin{code}
  47 #include "HsVersions.h"
  48
  49 #define ACCUM_COSTS(i,b,l,s,f)  (i+b+l+s+f)
  50
  51 #define NUM_REGS                10 {- PprAbsCSyn.lhs -}       {- runtime/c-as-asm/CallWrap_C.lc -}
  52 #define RESTORE_COSTS           (Cost (0, 0, NUM_REGS, 0, 0)  :: CostRes)
  53 #define SAVE_COSTS              (Cost (0, 0, 0, NUM_REGS, 0)  :: CostRes)
  54 #define CCALL_COSTS_GUESS       (Cost (50, 0, 0, 0, 0)        :: CostRes)
  55
  56 module Costs( costs,
  57               addrModeCosts, CostRes(Cost), nullCosts, Side(..)
  58     ) where
  59
  60 import AbsCUtils
  61 import AbsCSyn
  62 import PrelInfo
  63 import PrimOp
  64 import TyCon
  65 import Util
  66
  67 -- --------------------------------------------------------------------------
  68 #ifndef GRAN
  69 -- a module of "stubs" that don't do anything
  70 data CostRes = Cost (Int, Int, Int, Int, Int)
  71 data Side = Lhs | Rhs
  72
  73 nullCosts    = Cost (0, 0, 0, 0, 0) :: CostRes
  74
  75 costs :: AbstractC -> CostRes
  76 addrModeCosts :: CAddrMode -> Side -> CostRes
  77 costs _ = nullCosts
  78 addrModeCosts _ _ = nullCosts
  79
  80 instance Eq CostRes; instance Text CostRes
  81
  82 instance Num CostRes where
  83     x + y = nullCosts
  84
  85 #else {-GRAN-}
  86 -- the real thing
  87
  88 data CostRes = Cost (Int, Int, Int, Int, Int)
  89                deriving (Text)
  90
  91 nullCosts    = Cost (0, 0, 0, 0, 0) :: CostRes
  92 initHdrCosts = Cost (2, 0, 0, 1, 0) :: CostRes
  93 errorCosts   = Cost (-1, -1, -1, -1, -1)  -- just for debugging
  94
  95 oneArithm = Cost (1, 0, 0, 0, 0) :: CostRes
  96
  97 instance Eq CostRes where
  98  (==) t1 t2 = i && b && l && s && f
  99              where (i,b,l,s,f) = binOp' (==) t1 t2
 100
 101 instance Num CostRes where
 102  (+) = binOp (+)
 103  (-) = binOp (-)
 104  (*) = binOp (*)
 105  negate  = mapOp negate
 106  abs     = mapOp abs
 107  signum  = mapOp signum
 108
 109 mapOp :: (Int -> Int) -> CostRes -> CostRes
 110 mapOp g ( Cost (i, b, l, s, f) )  = Cost (g i, g b, g l, g s, g f)
 111
 112 foldrOp :: (Int -> a -> a) -> a -> CostRes -> a
 113 foldrOp o x  ( Cost (i1, b1, l1, s1, f1) )   =
 114         i1 `o` ( b1 `o` ( l1 `o` ( s1 `o` ( f1 `o` x))))
 115
 116 binOp :: (Int -> Int -> Int) -> CostRes -> CostRes -> CostRes
 117 binOp o ( Cost (i1, b1, l1, s1, f1) ) ( Cost  (i2, b2, l2, s2, f2) )  =
 118         ( Cost (i1 `o` i2, b1 `o` b2, l1 `o` l2, s1 `o` s2, f1 `o` f2) )
 119
 120 binOp' :: (Int -> Int -> a) -> CostRes -> CostRes -> (a,a,a,a,a)
 121 binOp' o ( Cost (i1, b1, l1, s1, f1) ) ( Cost  (i2, b2, l2, s2, f2) )  =
 122          (i1 `o` i2, b1 `o` b2, l1 `o` l2, s1 `o` s2, f1 `o` f2)
 123
 124 -- --------------------------------------------------------------------------
 125
 126 data Side = Lhs | Rhs
 127             deriving (Eq)
 128
 129 -- --------------------------------------------------------------------------
 130
 131 costs :: AbstractC -> CostRes
 132
 133 costs absC =
 134   case absC of
 135    AbsCNop                      ->  nullCosts
 136
 137    AbsCStmts absC1 absC2        -> costs absC1 + costs absC2
 138
 139    CAssign (CReg _) (CReg _)    -> Cost (1,0,0,0,0)   -- typ.: mov %reg1,%reg2
 140
 141    CAssign (CReg _) (CTemp _ _) -> Cost (1,0,0,0,0)
 142
 143    CAssign (CReg _) (CAddr _)   -> Cost (1,0,0,0,0)  -- typ.: add %reg1,<adr>,%reg2
 144
 145    CAssign target_m source_m    -> addrModeCosts target_m Lhs +
 146                                    addrModeCosts source_m Rhs
 147
 148    CJump (CLbl _  _)            -> Cost (0,1,0,0,0)  -- no ld for call necessary
 149
 150    CJump mode                   -> addrModeCosts mode Rhs +
 151                                    Cost (0,1,0,0,0)
 152
 153    CFallThrough mode  -> addrModeCosts mode Rhs +               -- chu' 0.24
 154                          Cost (0,1,0,0,0)
 155
 156    CReturn mode info  -> case info of
 157                           DirectReturn -> addrModeCosts mode Rhs +
 158                                           Cost (0,1,0,0,0)
 159
 160                             -- i.e. ld address to reg and call reg
 161
 162                           DynamicVectoredReturn mode' ->
 163                                         addrModeCosts mode Rhs +
 164                                         addrModeCosts mode' Rhs +
 165                                         Cost (0,1,1,0,0)
 166
 167                             {- generates code like this:
 168                                 JMP_(<mode>)[RVREL(<mode'>)];
 169                                i.e. 1 possb ld for mode'
 170                                     1 ld for RVREL
 171                                     1 possb ld for mode
 172                                     1 call                              -}
 173
 174                           StaticVectoredReturn _ -> addrModeCosts mode Rhs +
 175                                                   Cost (0,1,1,0,0)
 176
 177                             -- as above with mode' fixed to CLit
 178                             -- typically 2 ld + 1 call; 1st ld due
 179                             -- to CVal as mode
 180
 181    CSwitch mode alts absC     -> nullCosts
 182                                  {- for handling costs of all branches of
 183                                     a CSwitch see PprAbsC.
 184                                     Basically:
 185                                      Costs for branch =
 186                                         Costs before CSwitch +
 187                                         addrModeCosts of head +
 188                                         Costs for 1 cond branch +
 189                                         Costs for body of branch
 190                                  -}
 191
 192    CCodeBlock _ absC          -> costs absC
 193
 194    CInitHdr cl_info reg_rel cost_centre inplace_upd -> initHdrCosts
 195
 196                         {- This is more fancy but superflous: The addr modes
 197                            are fixed and so the costs are const!
 198
 199                         argCosts + initHdrCosts
 200                         where argCosts = addrModeCosts (CAddr reg_rel) Rhs +
 201                                          addrModeCosts base_lbl +    -- CLbl!
 202                                          3*addrModeCosts (mkIntCLit 1{- any val -})
 203                         -}
 204                         {- this extends to something like
 205                             SET_SPEC_HDR(...)
 206                            For costing the args of this macro
 207                            see PprAbsC.lhs where args are inserted -}
 208
 209    COpStmt modes_res primOp modes_args _ _ ->
 210         {-
 211            let
 212                 n = length modes_res
 213            in
 214                 (0, 0, n, n, 0) +
 215                 primOpCosts primOp +
 216                 if primOpNeedsWrapper primOp then SAVE_COSTS + RESTORE_COSTS
 217                                              else nullCosts
 218            -- ^^HWL
 219         -}
 220         foldl (+) nullCosts [addrModeCosts mode Lhs | mode <- modes_res]  +
 221         foldl (+) nullCosts [addrModeCosts mode Rhs | mode <- modes_args]  +
 222         primOpCosts primOp +
 223         if primOpNeedsWrapper primOp then SAVE_COSTS + RESTORE_COSTS
 224                                      else nullCosts
 225
 226    CSimultaneous absC        -> costs absC
 227
 228    CMacroStmt   macro modes  -> stmtMacroCosts macro modes
 229
 230    CCallProfCtrMacro   _ _   -> nullCosts
 231                                   {- we don't count profiling in GrAnSim -}
 232
 233    CCallProfCCMacro    _ _   -> nullCosts
 234                                   {- we don't count profiling in GrAnSim -}
 235
 236   -- *** the next three [or so...] are DATA (those above are CODE) ***
 237   -- as they are data rather than code they all have nullCosts         -- HWL
 238
 239    CStaticClosure _ _ _ _    -> nullCosts
 240
 241    CClosureInfoAndCode _ _ _ _ _ _ -> nullCosts
 242
 243    CRetVector _ _ _          -> nullCosts
 244
 245    CRetUnVector _ _          -> nullCosts
 246
 247    CFlatRetVector _ _        -> nullCosts
 248
 249    CCostCentreDecl _ _       -> nullCosts
 250
 251    CClosureUpdInfo _         -> nullCosts
 252
 253    CSplitMarker              -> nullCosts
 254
 255 -- ---------------------------------------------------------------------------
 256
 257 addrModeCosts :: CAddrMode -> Side -> CostRes
 258
 259 -- addrModeCosts _ _ = nullCosts
 260
 261 addrModeCosts addr_mode side =
 262   let
 263     lhs = side == Lhs
 264   in
 265   case addr_mode of
 266     CVal _ _ -> if lhs then Cost (0, 0, 0, 1, 0)
 267                        else Cost (0, 0, 1, 0, 0)
 268
 269     CAddr _  -> if lhs then Cost (0, 0, 0, 1, 0)  -- ??unchecked
 270                        else Cost (0, 0, 1, 0, 0)
 271
 272     CReg _   -> nullCosts        {- loading from, storing to reg is free ! -}
 273                                  {- for costing CReg->Creg ops see special -}
 274                                  {- case in costs fct -}
 275     CTableEntry base_mode offset_mode kind ->
 276                 addrModeCosts base_mode side +
 277                 addrModeCosts offset_mode side +
 278                 Cost (1,0,1,0,0)
 279
 280     CTemp _ _  -> nullCosts     {- if lhs then Cost (0, 0, 0, 1, 0)
 281                                           else Cost (0, 0, 1, 0, 0)  -}
 282         -- ``Temporaries'' correspond to local variables in C, and registers in
 283         -- native code.
 284         -- I assume they can be somewhat optimized by gcc -- HWL
 285
 286     CLbl _ _   -> if lhs then Cost (0, 0, 0, 1, 0)
 287                          else Cost (2, 0, 0, 0, 0)
 288                   -- Rhs: typically: sethi %hi(lbl),%tmp_reg
 289                   --                 or    %tmp_reg,%lo(lbl),%target_reg
 290
 291     CUnVecLbl _ _ -> if lhs then Cost (0, 0, 0, 1, 0)
 292                             else Cost (2, 0, 0, 0, 0)
 293                      -- same as CLbl
 294
 295     --  Check the following 3 (checked form CLit on)
 296
 297     CCharLike mode -> if lhs then Cost (0, 0, 0, 1, 0)
 298                              else Cost (0, 0, 1, 0, 0)
 299
 300     CIntLike mode  -> if lhs then Cost (0, 0, 0, 1, 0)
 301                              else Cost (0, 0, 1, 0, 0)
 302
 303     CString _      -> if lhs then Cost (0, 0, 0, 1, 0)
 304                              else Cost (0, 0, 1, 0, 0)
 305
 306     CLit    _      -> if lhs then nullCosts            -- should never occur
 307                              else Cost (1, 0, 0, 0, 0) -- typ.: mov lit,%reg
 308
 309     CLitLit _  _   -> if lhs then nullCosts
 310                              else Cost (1, 0, 0, 0, 0)
 311                       -- same es CLit
 312
 313     COffset _      -> if lhs then nullCosts
 314                              else Cost (1, 0, 0, 0, 0)
 315                       -- same es CLit
 316
 317     CCode absC     -> costs absC
 318
 319     CLabelledCode _ absC  ->  costs absC
 320
 321     CJoinPoint _ _        -> if lhs then Cost (0, 0, 0, 1, 0)
 322                                     else Cost (0, 0, 1, 0, 0)
 323
 324     CMacroExpr _ macro mode_list -> exprMacroCosts side macro mode_list
 325
 326     CCostCentre _ _ -> nullCosts
 327
 328 -- ---------------------------------------------------------------------------
 329
 330 exprMacroCosts :: Side -> CExprMacro -> [CAddrMode] -> CostRes
 331
 332 exprMacroCosts side macro mode_list =
 333   let
 334     arg_costs = foldl (+) nullCosts
 335                       (map (\ x -> addrModeCosts x Rhs) mode_list)
 336   in
 337   arg_costs +
 338   case macro of
 339     INFO_PTR   -> if side == Lhs then Cost (0, 0, 0, 1, 0)
 340                                  else Cost (0, 0, 1, 0, 0)
 341     ENTRY_CODE -> nullCosts
 342     INFO_TAG   -> if side == Lhs then Cost (0, 0, 0, 1, 0)
 343                                  else Cost (0, 0, 1, 0, 0)
 344     EVAL_TAG   -> if side == Lhs then Cost (1, 0, 0, 1, 0)
 345                                  else Cost (1, 0, 1, 0, 0)
 346                   -- costs of INFO_TAG + (1,0,0,0,0)
 347
 348 -- ---------------------------------------------------------------------------
 349
 350 stmtMacroCosts :: CStmtMacro -> [CAddrMode] -> CostRes
 351
 352 stmtMacroCosts macro modes =
 353   let
 354     arg_costs =   foldl (+) nullCosts
 355                         [addrModeCosts mode Rhs | mode <- modes]
 356   in
 357   case macro of
 358     ARGS_CHK_A_LOAD_NODE  ->  Cost (2, 1, 0, 0, 0)       {- StgMacros.lh  -}
 359                 -- p=probability of PAP (instead of AP): + p*(3,1,0,0,0)
 360     ARGS_CHK_A            ->  Cost (2, 1, 0, 0, 0)       {- StgMacros.lh  -}
 361                 -- p=probability of PAP (instead of AP): + p*(0,1,0,0,0)
 362     ARGS_CHK_B_LOAD_NODE  ->  Cost (2, 1, 0, 0, 0)       {- StgMacros.lh  -}
 363     ARGS_CHK_B            ->  Cost (2, 1, 0, 0, 0)       {- StgMacros.lh  -}
 364     HEAP_CHK              ->  Cost (2, 1, 0, 0, 0)       {- StgMacros.lh  -}
 365     -- STK_CHK               ->  (2, 1, 0, 0, 0)       {- StgMacros.lh  -}
 366     STK_CHK               ->  Cost (0, 0, 0, 0, 0)       {- StgMacros.lh  -}
 367     UPD_CAF               ->  Cost (7, 0, 1, 3, 0)       {- SMupdate.lh  -}
 368     UPD_IND               ->  Cost (8, 2, 2, 0, 0)       {- SMupdate.lh
 369                                 updatee in old-gen: Cost (4, 1, 1, 0, 0)
 370                                 updatee in new-gen: Cost (4, 1, 1, 0, 0)
 371                                 NB: we include costs fo checking if there is
 372                                     a BQ, but we omit costs for awakening BQ
 373                                     (these probably differ between old-gen and
 374                                     new gen) -}
 375     UPD_INPLACE_NOPTRS    ->  Cost (13, 3, 3, 2, 0)       {- SMupdate.lh
 376                                 common for both:    Cost (4, 1, 1, 0, 0)
 377                                 updatee in old-gen: Cost (14, 3, 2, 4, 0)
 378                                 updatee in new-gen: Cost (4, 1, 1, 0, 0)   -}
 379     UPD_INPLACE_PTRS      ->  Cost (13, 3, 3, 2, 0)       {- SMupdate.lh
 380                                 common for both:    Cost (4, 1, 1, 0, 0)
 381                                 updatee in old-gen: Cost (14, 3, 2, 4, 0)
 382                                 updatee in new-gen: Cost (4, 1, 1, 0, 0)   -}
 383
 384     UPD_BH_UPDATABLE      ->  Cost (3, 0, 0, 1, 0)       {- SMupdate.lh  -}
 385     UPD_BH_SINGLE_ENTRY   ->  Cost (3, 0, 0, 1, 0)       {- SMupdate.lh  -}
 386     PUSH_STD_UPD_FRAME    ->  Cost (3, 0, 0, 4, 0)       {- SMupdate.lh  -}
 387     POP_STD_UPD_FRAME     ->  Cost (1, 0, 3, 0, 0)       {- SMupdate.lh  -}
 388     SET_ARITY             ->  nullCosts             {- StgMacros.lh  -}
 389     CHK_ARITY             ->  nullCosts             {- StgMacros.lh  -}
 390     SET_TAG               ->  nullCosts             {- COptRegs.lh -}
 391     GRAN_FETCH                  ->  nullCosts     {- GrAnSim bookkeeping -}
 392     GRAN_RESCHEDULE             ->  nullCosts     {- GrAnSim bookkeeping -}
 393     GRAN_FETCH_AND_RESCHEDULE   ->  nullCosts     {- GrAnSim bookkeeping -}
 394     THREAD_CONTEXT_SWITCH       ->  nullCosts     {- GrAnSim bookkeeping -}
 395
 396 -- ---------------------------------------------------------------------------
 397
 398 floatOps :: [PrimOp]
 399 floatOps =
 400   [   FloatGtOp  , FloatGeOp  , FloatEqOp  , FloatNeOp  , FloatLtOp  , FloatLeOp
 401     , DoubleGtOp , DoubleGeOp , DoubleEqOp , DoubleNeOp , DoubleLtOp , DoubleLeOp
 402     , FloatAddOp , FloatSubOp , FloatMulOp , FloatDivOp , FloatNegOp
 403     , Float2IntOp , Int2FloatOp
 404     , FloatExpOp   , FloatLogOp   , FloatSqrtOp
 405     , FloatSinOp   , FloatCosOp   , FloatTanOp
 406     , FloatAsinOp  , FloatAcosOp  , FloatAtanOp
 407     , FloatSinhOp  , FloatCoshOp  , FloatTanhOp
 408     , FloatPowerOp
 409     , DoubleAddOp , DoubleSubOp , DoubleMulOp , DoubleDivOp , DoubleNegOp
 410     , Double2IntOp , Int2DoubleOp
 411     , Double2FloatOp , Float2DoubleOp
 412     , DoubleExpOp   , DoubleLogOp   , DoubleSqrtOp
 413     , DoubleSinOp   , DoubleCosOp   , DoubleTanOp
 414     , DoubleAsinOp  , DoubleAcosOp  , DoubleAtanOp
 415     , DoubleSinhOp  , DoubleCoshOp  , DoubleTanhOp
 416     , DoublePowerOp
 417     , FloatEncodeOp  , FloatDecodeOp
 418     , DoubleEncodeOp , DoubleDecodeOp
 419   ]
 420
 421 gmpOps :: [PrimOp]
 422 gmpOps  =
 423   [   IntegerAddOp , IntegerSubOp , IntegerMulOp
 424     , IntegerQuotRemOp , IntegerDivModOp , IntegerNegOp
 425     , IntegerCmpOp
 426     , Integer2IntOp  , Int2IntegerOp
 427     , Addr2IntegerOp
 428   ]
 429
 430
 431 -- Haven't found the .umul .div .rem macros yet
 432 -- If they are not Haskell cde, they are not costed, yet
 433
 434 abs_costs = nullCosts  -- NB:  This is normal STG code with costs already
 435                         --      included; no need to add costs again.
 436
 437 umul_costs = Cost (21,4,0,0,0)     -- due to spy counts
 438 rem_costs =  Cost (30,15,0,0,0)    -- due to spy counts
 439 div_costs =  Cost (30,15,0,0,0)    -- due to spy counts
 440
 441 primOpCosts :: PrimOp -> CostRes
 442
 443 -- Special cases
 444
 445 primOpCosts (CCallOp _ _ _ _ _) = SAVE_COSTS + CCALL_COSTS_GUESS +
 446                                   RESTORE_COSTS         -- GUESS; check it
 447
 448 -- Usually 3 mov instructions are needed to get args and res in right place.
 449
 450 primOpCosts IntMulOp  = Cost (3, 1, 0, 0, 0)  + umul_costs
 451 primOpCosts IntQuotOp = Cost (3, 1, 0, 0, 0)  + div_costs
 452 primOpCosts IntRemOp  = Cost (3, 1, 0, 0, 0)  + rem_costs
 453 primOpCosts IntNegOp  = Cost (1, 1, 0, 0, 0) -- translates into 1 sub
 454 primOpCosts IntAbsOp  = Cost (0, 1, 0, 0, 0) -- abs closure already costed
 455
 456 primOpCosts FloatGtOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 457 primOpCosts FloatGeOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 458 primOpCosts FloatEqOp  = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 459 primOpCosts FloatNeOp  = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 460 primOpCosts FloatLtOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 461 primOpCosts FloatLeOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 462 primOpCosts DoubleGtOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 463 primOpCosts DoubleGeOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 464 primOpCosts DoubleEqOp = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 465 primOpCosts DoubleNeOp = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 466 primOpCosts DoubleLtOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 467 primOpCosts DoubleLeOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 468
 469 primOpCosts FloatExpOp    = Cost (2, 1, 4, 4, 3)
 470 primOpCosts FloatLogOp    = Cost (2, 1, 4, 4, 3)
 471 primOpCosts FloatSqrtOp   = Cost (2, 1, 4, 4, 3)
 472 primOpCosts FloatSinOp    = Cost (2, 1, 4, 4, 3)
 473 primOpCosts FloatCosOp    = Cost (2, 1, 4, 4, 3)
 474 primOpCosts FloatTanOp    = Cost (2, 1, 4, 4, 3)
 475 primOpCosts FloatAsinOp   = Cost (2, 1, 4, 4, 3)
 476 primOpCosts FloatAcosOp   = Cost (2, 1, 4, 4, 3)
 477 primOpCosts FloatAtanOp   = Cost (2, 1, 4, 4, 3)
 478 primOpCosts FloatSinhOp   = Cost (2, 1, 4, 4, 3)
 479 primOpCosts FloatCoshOp   = Cost (2, 1, 4, 4, 3)
 480 primOpCosts FloatTanhOp   = Cost (2, 1, 4, 4, 3)
 481 --primOpCosts FloatAsinhOp  = Cost (2, 1, 4, 4, 3)
 482 --primOpCosts FloatAcoshOp  = Cost (2, 1, 4, 4, 3)
 483 --primOpCosts FloatAtanhOp  = Cost (2, 1, 4, 4, 3)
 484 primOpCosts FloatPowerOp  = Cost (2, 1, 4, 4, 3)
 485
 486 {- There should be special handling of the Array PrimOps in here   HWL -}
 487
 488 primOpCosts primOp
 489   | primOp `elem` floatOps = Cost (0, 0, 0, 0, 1)  :: CostRes
 490   | primOp `elem` gmpOps   = Cost (50, 5, 10, 10, 0) :: CostRes  -- GUESS; check it
 491   | otherwise              = Cost (1, 0, 0, 0, 0)
 492
 493 -- ---------------------------------------------------------------------------
 494 {- HWL: currently unused
 495
 496 costsByKind :: PrimRep -> Side -> CostRes
 497
 498 -- The following PrimKinds say that the data is already in a reg
 499
 500 costsByKind CharRep     _ = nullCosts
 501 costsByKind IntRep      _ = nullCosts
 502 costsByKind WordRep     _ = nullCosts
 503 costsByKind AddrRep     _ = nullCosts
 504 costsByKind FloatRep    _ = nullCosts
 505 costsByKind DoubleRep   _ = nullCosts
 506 -}
 507 -- ---------------------------------------------------------------------------
 508
 509 #endif {-GRAN-}
 510 \end{code}
 511
 512 This is the data structure of {\tt PrimOp} copied from prelude/PrimOp.lhs.
 513 I include here some comments about the estimated costs for these @PrimOps@.
 514 Compare with the @primOpCosts@ fct above.  -- HWL
 515
 516 \begin{pseudocode}
 517 data PrimOp
 518     -- I assume all these basic comparisons take just one ALU instruction
 519     -- Checked that for Char, Int; Word, Addr should be the same as Int.
 520
 521     = CharGtOp   | CharGeOp   | CharEqOp   | CharNeOp   | CharLtOp   | CharLeOp
 522     | IntGtOp    | IntGeOp    | IntEqOp    | IntNeOp    | IntLtOp    | IntLeOp
 523     | WordGtOp   | WordGeOp   | WordEqOp   | WordNeOp   | WordLtOp   | WordLeOp
 524     | AddrGtOp   | AddrGeOp   | AddrEqOp   | AddrNeOp   | AddrLtOp   | AddrLeOp
 525
 526     -- Analogously, these take one FP unit instruction
 527     -- Haven't checked that, yet.
 528
 529     | FloatGtOp  | FloatGeOp  | FloatEqOp  | FloatNeOp  | FloatLtOp  | FloatLeOp
 530     | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
 531
 532     -- 1 ALU op; unchecked
 533     | OrdOp | ChrOp
 534
 535     -- these just take 1 ALU op; checked
 536     | IntAddOp | IntSubOp
 537
 538     -- but these take more than that; see special cases in primOpCosts
 539     -- I counted the generated ass. instructions for these -> checked
 540     | IntMulOp | IntQuotOp
 541     | IntRemOp | IntNegOp | IntAbsOp
 542
 543     -- Rest is unchecked so far -- HWL
 544
 545     -- Word#-related ops:
 546     | AndOp   | OrOp  | NotOp | ShiftLOp | ShiftROp
 547     | Int2WordOp | Word2IntOp -- casts
 548
 549     -- Addr#-related ops:
 550     | Int2AddrOp | Addr2IntOp -- casts
 551
 552     -- Float#-related ops:
 553     | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp
 554     | Float2IntOp | Int2FloatOp
 555
 556     | FloatExpOp   | FloatLogOp   | FloatSqrtOp
 557     | FloatSinOp   | FloatCosOp   | FloatTanOp
 558     | FloatAsinOp  | FloatAcosOp  | FloatAtanOp
 559     | FloatSinhOp  | FloatCoshOp  | FloatTanhOp
 560     -- not all machines have these available conveniently:
 561     -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp
 562     | FloatPowerOp -- ** op
 563
 564     -- Double#-related ops:
 565     | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp
 566     | Double2IntOp | Int2DoubleOp
 567     | Double2FloatOp | Float2DoubleOp
 568
 569     | DoubleExpOp   | DoubleLogOp   | DoubleSqrtOp
 570     | DoubleSinOp   | DoubleCosOp   | DoubleTanOp
 571     | DoubleAsinOp  | DoubleAcosOp  | DoubleAtanOp
 572     | DoubleSinhOp  | DoubleCoshOp  | DoubleTanhOp
 573     -- not all machines have these available conveniently:
 574     -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp
 575     | DoublePowerOp -- ** op
 576
 577     -- Integer (and related...) ops:
 578     -- slightly weird -- to match GMP package.
 579     | IntegerAddOp | IntegerSubOp | IntegerMulOp
 580     | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
 581
 582     | IntegerCmpOp
 583
 584     | Integer2IntOp  | Int2IntegerOp
 585     | Addr2IntegerOp -- "Addr" is *always* a literal string
 586     -- ?? gcd, etc?
 587
 588     | FloatEncodeOp  | FloatDecodeOp
 589     | DoubleEncodeOp | DoubleDecodeOp
 590
 591     -- primitive ops for primitive arrays
 592
 593     | NewArrayOp
 594     | NewByteArrayOp PrimRep
 595
 596     | SameMutableArrayOp
 597     | SameMutableByteArrayOp
 598
 599     | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
 600
 601     | ReadByteArrayOp   PrimRep
 602     | WriteByteArrayOp  PrimRep
 603     | IndexByteArrayOp  PrimRep
 604     | IndexOffAddrOp    PrimRep
 605         -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
 606         -- This is just a cheesy encoding of a bunch of ops.
 607         -- Note that MallocPtrRep is not included -- the only way of
 608         -- creating a MallocPtr is with a ccall or casm.
 609
 610     | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
 611
 612     | MakeStablePtrOp | DeRefStablePtrOp
 613 \end{pseudocode}
 614
 615 A special ``trap-door'' to use in making calls direct to C functions:
 616 Note: From GrAn point of view, CCall is probably very expensive -- HWL
 617
 618 \begin{pseudocode}
 619     | CCallOp   String  -- An "unboxed" ccall# to this named function
 620                 Bool    -- True <=> really a "casm"
 621                 Bool    -- True <=> might invoke Haskell GC
 622                 [Type]  -- Unboxed argument; the state-token
 623                         -- argument will have been put *first*
 624                 Type    -- Return type; one of the "StateAnd<blah>#" types
 625
 626     -- (... to be continued ... )
 627 \end{pseudocode}