GHC/CmmToAsm/Reg/Linear/Stats.hs

    module GHC.CmmToAsm.Reg.Linear.Stats (
            binSpillReasons,
            countRegRegMovesNat,
            pprStats
    )

    where

    import GHC.Prelude

    import GHC.CmmToAsm.Reg.Linear.Base
    import GHC.CmmToAsm.Reg.Liveness
    import GHC.CmmToAsm.Instr
    import GHC.Types.Unique (Unique)
    import GHC.CmmToAsm.Types

    import GHC.Types.Unique.FM

    import GHC.Utils.Outputable
    import GHC.Utils.Monad.State

    -- | Build a map of how many times each reg was alloced, clobbered, loaded etc.
    binSpillReasons
            :: [SpillReason] -> UniqFM Unique [Int]
            -- See Note [UniqFM and the register allocator]
    binSpillReasons reasons
            = addListToUFM_C
                    (zipWith (+))
                    emptyUFM
                    (map (\reason -> case reason of
                            SpillAlloc r    -> (r, [1, 0, 0, 0, 0])
                            SpillClobber r  -> (r, [0, 1, 0, 0, 0])
                            SpillLoad r     -> (r, [0, 0, 1, 0, 0])
                            SpillJoinRR r   -> (r, [0, 0, 0, 1, 0])
                            SpillJoinRM r   -> (r, [0, 0, 0, 0, 1])) reasons)

    -- | Count reg-reg moves remaining in this code.
    countRegRegMovesNat
            :: Instruction instr
            => NatCmmDecl statics instr -> Int

    countRegRegMovesNat cmm
            = execState (mapGenBlockTopM countBlock cmm) 0
     where
            countBlock b@(BasicBlock _ instrs)
             = do   mapM_ countInstr instrs
                    return  b

            countInstr instr
                    | Just _        <- takeRegRegMoveInstr instr
                    = do    modify (+ 1)
                            return instr

                    | otherwise
                    =       return instr

    -- | Pretty print some RegAllocStats
    pprStats
            :: Instruction instr
            => [NatCmmDecl statics instr] -> [RegAllocStats] -> SDoc

    pprStats code statss
     = let  -- sum up all the instrs inserted by the spiller
            -- See Note [UniqFM and the register allocator]
            spills :: UniqFM Unique [Int]
            spills          = foldl' (plusUFM_C (zipWith (+)))
                                    emptyUFM
                            $ map ra_spillInstrs statss

            spillTotals     = foldl' (zipWith (+))
                                    [0, 0, 0, 0, 0]
                            $ nonDetEltsUFM spills
                            -- See Note [Unique Determinism and code generation]

            -- count how many reg-reg-moves remain in the code
            moves           = sum $ map countRegRegMovesNat code

            pprSpill (reg, spills)
                    = parens $ (hcat $ punctuate (text ", ")  (doubleQuotes (ppr reg) : map ppr spills))

       in   (  text "-- spills-added-total"
            $$ text "--    (allocs, clobbers, loads, joinRR, joinRM, reg_reg_moves_remaining)"
            $$ (parens $ (hcat $ punctuate (text ", ") (map ppr spillTotals ++ [ppr moves])))
            $$ text ""
            $$ text "-- spills-added"
            $$ text "--    (reg_name, allocs, clobbers, loads, joinRR, joinRM)"
            $$ (pprUFMWithKeys spills (vcat . map pprSpill))
            $$ text "")