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