ghc/compiler/absCSyn/Costs.lhs

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