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 AbsCFuns
  61 import AbsCSyn
  62 import AbsPrel
  63 import PrimOps
  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 IntDivOp  = Cost (3, 1, 0, 0, 0) -- div dclosure already costed
 453 primOpCosts IntRemOp  = Cost (3, 1, 0, 0, 0)  + rem_costs
 454 primOpCosts IntNegOp  = Cost (1, 1, 0, 0, 0) -- translates into 1 sub
 455 primOpCosts IntAbsOp  = Cost (0, 1, 0, 0, 0) -- abs closure already costed
 456
 457 primOpCosts FloatGtOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 458 primOpCosts FloatGeOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 459 primOpCosts FloatEqOp  = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 460 primOpCosts FloatNeOp  = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 461 primOpCosts FloatLtOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 462 primOpCosts FloatLeOp  = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 463 primOpCosts DoubleGtOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 464 primOpCosts DoubleGeOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 465 primOpCosts DoubleEqOp = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 466 primOpCosts DoubleNeOp = Cost (0, 0, 0, 0, 2) -- cheap f-comp
 467 primOpCosts DoubleLtOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 468 primOpCosts DoubleLeOp = Cost (2, 0, 0, 0, 2) -- expensive f-comp
 469
 470 primOpCosts FloatExpOp    = Cost (2, 1, 4, 4, 3)
 471 primOpCosts FloatLogOp    = Cost (2, 1, 4, 4, 3)
 472 primOpCosts FloatSqrtOp   = Cost (2, 1, 4, 4, 3)
 473 primOpCosts FloatSinOp    = Cost (2, 1, 4, 4, 3)
 474 primOpCosts FloatCosOp    = Cost (2, 1, 4, 4, 3)
 475 primOpCosts FloatTanOp    = Cost (2, 1, 4, 4, 3)
 476 primOpCosts FloatAsinOp   = Cost (2, 1, 4, 4, 3)
 477 primOpCosts FloatAcosOp   = Cost (2, 1, 4, 4, 3)
 478 primOpCosts FloatAtanOp   = Cost (2, 1, 4, 4, 3)
 479 primOpCosts FloatSinhOp   = Cost (2, 1, 4, 4, 3)
 480 primOpCosts FloatCoshOp   = Cost (2, 1, 4, 4, 3)
 481 primOpCosts FloatTanhOp   = Cost (2, 1, 4, 4, 3)
 482 --primOpCosts FloatAsinhOp  = Cost (2, 1, 4, 4, 3)
 483 --primOpCosts FloatAcoshOp  = Cost (2, 1, 4, 4, 3)
 484 --primOpCosts FloatAtanhOp  = Cost (2, 1, 4, 4, 3)
 485 primOpCosts FloatPowerOp  = Cost (2, 1, 4, 4, 3)
 486
 487 {- There should be special handling of the Array PrimOps in here   HWL -}
 488
 489 primOpCosts primOp
 490   | primOp `elem` floatOps = Cost (0, 0, 0, 0, 1)  :: CostRes
 491   | primOp `elem` gmpOps   = Cost (50, 5, 10, 10, 0) :: CostRes  -- GUESS; check it
 492   | otherwise              = Cost (1, 0, 0, 0, 0)
 493
 494 -- ---------------------------------------------------------------------------
 495 {- HWL: currently unused
 496
 497 costsByKind :: PrimKind -> Side -> CostRes
 498
 499 -- The following PrimKinds say that the data is already in a reg
 500
 501 costsByKind CharKind    _ = nullCosts
 502 costsByKind IntKind     _ = nullCosts
 503 costsByKind WordKind    _ = nullCosts
 504 costsByKind AddrKind    _ = nullCosts
 505 costsByKind FloatKind   _ = nullCosts
 506 costsByKind DoubleKind  _ = nullCosts
 507 -}
 508 -- ---------------------------------------------------------------------------
 509
 510 #endif {-GRAN-}
 511 \end{code}
 512
 513 This is the data structure of {\tt PrimOp} copied from prelude/PrimOps.lhs.
 514 I include here some comments about the estimated costs for these @PrimOps@.
 515 Compare with the @primOpCosts@ fct above.  -- HWL
 516
 517 \begin{pseudocode}
 518 data PrimOp
 519     -- I assume all these basic comparisons take just one ALU instruction
 520     -- Checked that for Char, Int; Word, Addr should be the same as Int.
 521
 522     = CharGtOp   | CharGeOp   | CharEqOp   | CharNeOp   | CharLtOp   | CharLeOp
 523     | IntGtOp    | IntGeOp    | IntEqOp    | IntNeOp    | IntLtOp    | IntLeOp
 524     | WordGtOp   | WordGeOp   | WordEqOp   | WordNeOp   | WordLtOp   | WordLeOp
 525     | AddrGtOp   | AddrGeOp   | AddrEqOp   | AddrNeOp   | AddrLtOp   | AddrLeOp
 526
 527     -- Analogously, these take one FP unit instruction
 528     -- Haven't checked that, yet.
 529
 530     | FloatGtOp  | FloatGeOp  | FloatEqOp  | FloatNeOp  | FloatLtOp  | FloatLeOp
 531     | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
 532
 533     -- 1 ALU op; unchecked
 534     | OrdOp | ChrOp
 535
 536     -- these just take 1 ALU op; checked
 537     | IntAddOp | IntSubOp
 538
 539     -- but these take more than that; see special cases in primOpCosts
 540     -- I counted the generated ass. instructions for these -> checked
 541     | IntMulOp | IntQuotOp
 542     | IntDivOp | IntRemOp | IntNegOp | IntAbsOp
 543
 544     -- Rest is unchecked so far -- HWL
 545
 546     -- Word#-related ops:
 547     | AndOp   | OrOp  | NotOp | ShiftLOp | ShiftROp
 548     | Int2WordOp | Word2IntOp -- casts
 549
 550     -- Addr#-related ops:
 551     | Int2AddrOp | Addr2IntOp -- casts
 552
 553     -- Float#-related ops:
 554     | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp
 555     | Float2IntOp | Int2FloatOp
 556
 557     | FloatExpOp   | FloatLogOp   | FloatSqrtOp
 558     | FloatSinOp   | FloatCosOp   | FloatTanOp
 559     | FloatAsinOp  | FloatAcosOp  | FloatAtanOp
 560     | FloatSinhOp  | FloatCoshOp  | FloatTanhOp
 561     -- not all machines have these available conveniently:
 562     -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp
 563     | FloatPowerOp -- ** op
 564
 565     -- Double#-related ops:
 566     | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp
 567     | Double2IntOp | Int2DoubleOp
 568     | Double2FloatOp | Float2DoubleOp
 569
 570     | DoubleExpOp   | DoubleLogOp   | DoubleSqrtOp
 571     | DoubleSinOp   | DoubleCosOp   | DoubleTanOp
 572     | DoubleAsinOp  | DoubleAcosOp  | DoubleAtanOp
 573     | DoubleSinhOp  | DoubleCoshOp  | DoubleTanhOp
 574     -- not all machines have these available conveniently:
 575     -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp
 576     | DoublePowerOp -- ** op
 577
 578     -- Integer (and related...) ops:
 579     -- slightly weird -- to match GMP package.
 580     | IntegerAddOp | IntegerSubOp | IntegerMulOp
 581     | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
 582
 583     | IntegerCmpOp
 584
 585     | Integer2IntOp  | Int2IntegerOp
 586     | Addr2IntegerOp -- "Addr" is *always* a literal string
 587     -- ?? gcd, etc?
 588
 589     | FloatEncodeOp  | FloatDecodeOp
 590     | DoubleEncodeOp | DoubleDecodeOp
 591
 592     -- primitive ops for primitive arrays
 593
 594     | NewArrayOp
 595     | NewByteArrayOp PrimKind
 596
 597     | SameMutableArrayOp
 598     | SameMutableByteArrayOp
 599
 600     | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
 601
 602     | ReadByteArrayOp   PrimKind
 603     | WriteByteArrayOp  PrimKind
 604     | IndexByteArrayOp  PrimKind
 605     | IndexOffAddrOp    PrimKind
 606         -- PrimKind can be one of {Char,Int,Addr,Float,Double}Kind.
 607         -- This is just a cheesy encoding of a bunch of ops.
 608         -- Note that MallocPtrKind is not included -- the only way of
 609         -- creating a MallocPtr is with a ccall or casm.
 610
 611     | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
 612
 613     | MakeStablePtrOp | DeRefStablePtrOp
 614 \end{pseudocode}
 615
 616 A special ``trap-door'' to use in making calls direct to C functions:
 617 Note: From GrAn point of view, CCall is probably very expensive -- HWL
 618
 619 \begin{pseudocode}
 620     | CCallOp   String          -- An "unboxed" ccall# to this named function
 621                 Bool            -- True <=> really a "casm"
 622                 Bool            -- True <=> might invoke Haskell GC
 623                 [UniType]       -- Unboxed argument; the state-token
 624                                 -- argument will have been put *first*
 625                 UniType         -- Return type; one of the "StateAnd<blah>#" types
 626
 627     -- (... to be continued ... )
 628 \end{pseudocode}