Modules: CmmToAsm (#13009)

9 files changed, 0 insertions, 2830 deletions

diff --git a/compiler/nativeGen/RegAlloc/Graph/ArchBase.hs b/compiler/nativeGen/RegAlloc/Graph/ArchBase.hs
deleted file mode 100644
index c38d998779..0000000000
--- a/compiler/nativeGen/RegAlloc/Graph/ArchBase.hs
+++ /dev/null
@@ -1,163 +0,0 @@
-
--- | Utils for calculating general worst, bound, squeese and free, functions.
---
---   as per: "A Generalized Algorithm for Graph-Coloring Register Allocation"
---           Michael Smith, Normal Ramsey, Glenn Holloway.
---           PLDI 2004
---
---   These general versions are not used in GHC proper because they are too slow.
---   Instead, hand written optimised versions are provided for each architecture
---   in MachRegs*.hs
---
---   This code is here because we can test the architecture specific code against
---   it.
---
-module RegAlloc.Graph.ArchBase (
-        RegClass(..),
-        Reg(..),
-        RegSub(..),
-
-        worst,
-        bound,
-        squeese
-) where
-
-import GhcPrelude
-
-import UniqSet
-import UniqFM
-import Unique
-import MonadUtils (concatMapM)
-
-
--- Some basic register classes.
---      These aren't necessarily in 1-to-1 correspondence with the allocatable
---      RegClasses in MachRegs.hs
-data RegClass
-        -- general purpose regs
-        = ClassG32      -- 32 bit GPRs
-        | ClassG16      -- 16 bit GPRs
-        | ClassG8       -- 8  bit GPRs
-
-        -- floating point regs
-        | ClassF64      -- 64 bit FPRs
-        deriving (Show, Eq, Enum)
-
-
--- | A register of some class
-data Reg
-        -- a register of some class
-        = Reg RegClass Int
-
-        -- a sub-component of one of the other regs
-        | RegSub RegSub Reg
-        deriving (Show, Eq)
-
-
--- | so we can put regs in UniqSets
-instance Uniquable Reg where
-        getUnique (Reg c i)
-         = mkRegSingleUnique
-         $ fromEnum c * 1000 + i
-
-        getUnique (RegSub s (Reg c i))
-         = mkRegSubUnique
-         $ fromEnum s * 10000 + fromEnum c * 1000 + i
-
-        getUnique (RegSub _ (RegSub _ _))
-          = error "RegArchBase.getUnique: can't have a sub-reg of a sub-reg."
-
-
--- | A subcomponent of another register
-data RegSub
-        = SubL16        -- lowest 16 bits
-        | SubL8         -- lowest  8 bits
-        | SubL8H        -- second lowest 8 bits
-        deriving (Show, Enum, Ord, Eq)
-
-
--- | Worst case displacement
---
---      a node N of classN has some number of neighbors,
---      all of which are from classC.
---
---      (worst neighbors classN classC) is the maximum number of potential
---      colors for N that can be lost by coloring its neighbors.
---
--- This should be hand coded/cached for each particular architecture,
---      because the compute time is very long..
-worst   :: (RegClass    -> UniqSet Reg)
-        -> (Reg         -> UniqSet Reg)
-        -> Int -> RegClass -> RegClass -> Int
-
-worst regsOfClass regAlias neighbors classN classC
- = let  regAliasS regs  = unionManyUniqSets
-                        $ map regAlias
-                        $ nonDetEltsUniqSet regs
-                        -- This is non-deterministic but we do not
-                        -- currently support deterministic code-generation.
-                        -- See Note [Unique Determinism and code generation]
-
-        -- all the regs in classes N, C
-        regsN           = regsOfClass classN
-        regsC           = regsOfClass classC
-
-        -- all the possible subsets of c which have size < m
-        regsS           = filter (\s -> sizeUniqSet s >= 1
-                                     && sizeUniqSet s <= neighbors)
-                        $ powersetLS regsC
-
-        -- for each of the subsets of C, the regs which conflict
-        -- with posiblities for N
-        regsS_conflict
-                = map (\s -> intersectUniqSets regsN (regAliasS s)) regsS
-
-  in    maximum $ map sizeUniqSet $ regsS_conflict
-
-
--- | For a node N of classN and neighbors of classesC
---      (bound classN classesC) is the maximum number of potential
---      colors for N that can be lost by coloring its neighbors.
-bound   :: (RegClass    -> UniqSet Reg)
-        -> (Reg         -> UniqSet Reg)
-        -> RegClass -> [RegClass] -> Int
-
-bound regsOfClass regAlias classN classesC
- = let  regAliasS regs  = unionManyUniqSets
-                        $ map regAlias
-                        $ nonDetEltsUFM regs
-                        -- See Note [Unique Determinism and code generation]
-
-        regsC_aliases
-                = unionManyUniqSets
-                $ map (regAliasS . getUniqSet . regsOfClass) classesC
-
-        overlap = intersectUniqSets (regsOfClass classN) regsC_aliases
-
-   in   sizeUniqSet overlap
-
-
--- | The total squeese on a particular node with a list of neighbors.
---
---   A version of this should be constructed for each particular architecture,
---   possibly including uses of bound, so that alised registers don't get
---   counted twice, as per the paper.
-squeese :: (RegClass    -> UniqSet Reg)
-        -> (Reg         -> UniqSet Reg)
-        -> RegClass -> [(Int, RegClass)] -> Int
-
-squeese regsOfClass regAlias classN countCs
-        = sum
-        $ map (\(i, classC) -> worst regsOfClass regAlias i classN classC)
-        $ countCs
-
-
--- | powerset (for lists)
-powersetL :: [a] -> [[a]]
-powersetL       = concatMapM (\x -> [[],[x]])
-
-
--- | powersetLS (list of sets)
-powersetLS :: Uniquable a => UniqSet a -> [UniqSet a]
-powersetLS s    = map mkUniqSet $ powersetL $ nonDetEltsUniqSet s
-  -- See Note [Unique Determinism and code generation]
diff --git a/compiler/nativeGen/RegAlloc/Graph/ArchX86.hs b/compiler/nativeGen/RegAlloc/Graph/ArchX86.hs
deleted file mode 100644
index 0472e4cf09..0000000000
--- a/compiler/nativeGen/RegAlloc/Graph/ArchX86.hs
+++ /dev/null
@@ -1,161 +0,0 @@
-
--- | A description of the register set of the X86.
---
---   This isn't used directly in GHC proper.
---
---   See RegArchBase.hs for the reference.
---   See MachRegs.hs for the actual trivColorable function used in GHC.
---
-module RegAlloc.Graph.ArchX86 (
-        classOfReg,
-        regsOfClass,
-        regName,
-        regAlias,
-        worst,
-        squeese,
-) where
-
-import GhcPrelude
-
-import RegAlloc.Graph.ArchBase  (Reg(..), RegSub(..), RegClass(..))
-import UniqSet
-
-import qualified Data.Array as A
-
-
--- | Determine the class of a register
-classOfReg :: Reg -> RegClass
-classOfReg reg
- = case reg of
-        Reg c _         -> c
-
-        RegSub SubL16 _ -> ClassG16
-        RegSub SubL8  _ -> ClassG8
-        RegSub SubL8H _ -> ClassG8
-
-
--- | Determine all the regs that make up a certain class.
-regsOfClass :: RegClass -> UniqSet Reg
-regsOfClass c
- = case c of
-        ClassG32
-         -> mkUniqSet   [ Reg ClassG32  i
-                        | i <- [0..7] ]
-
-        ClassG16
-         -> mkUniqSet   [ RegSub SubL16 (Reg ClassG32 i)
-                        | i <- [0..7] ]
-
-        ClassG8
-         -> unionUniqSets
-                (mkUniqSet [ RegSub SubL8  (Reg ClassG32 i) | i <- [0..3] ])
-                (mkUniqSet [ RegSub SubL8H (Reg ClassG32 i) | i <- [0..3] ])
-
-        ClassF64
-         -> mkUniqSet   [ Reg ClassF64  i
-                        | i <- [0..5] ]
-
-
--- | Determine the common name of a reg
---      returns Nothing if this reg is not part of the machine.
-regName :: Reg -> Maybe String
-regName reg
- = case reg of
-        Reg ClassG32 i
-         | i <= 7 ->
-           let names = A.listArray (0,8)
-                       [ "eax", "ebx", "ecx", "edx"
-                       , "ebp", "esi", "edi", "esp" ]
-           in Just $ names A.! i
-
-        RegSub SubL16 (Reg ClassG32 i)
-         | i <= 7 ->
-           let names = A.listArray (0,8)
-                       [ "ax", "bx", "cx", "dx"
-                       , "bp", "si", "di", "sp"]
-           in Just $ names A.! i
-
-        RegSub SubL8  (Reg ClassG32 i)
-         | i <= 3 ->
-           let names = A.listArray (0,4) [ "al", "bl", "cl", "dl"]
-           in Just $ names A.! i
-
-        RegSub SubL8H (Reg ClassG32 i)
-         | i <= 3 ->
-           let names = A.listArray (0,4) [ "ah", "bh", "ch", "dh"]
-           in Just $ names A.! i
-
-        _         -> Nothing
-
-
--- | Which regs alias what other regs.
-regAlias :: Reg -> UniqSet Reg
-regAlias reg
- = case reg of
-
-        -- 32 bit regs alias all of the subregs
-        Reg ClassG32 i
-
-         -- for eax, ebx, ecx, eds
-         |  i <= 3
-         -> mkUniqSet
-         $ [ Reg ClassG32 i,   RegSub SubL16 reg
-           , RegSub SubL8 reg, RegSub SubL8H reg ]
-
-         -- for esi, edi, esp, ebp
-         | 4 <= i && i <= 7
-         -> mkUniqSet
-         $ [ Reg ClassG32 i,   RegSub SubL16 reg ]
-
-        -- 16 bit subregs alias the whole reg
-        RegSub SubL16 r@(Reg ClassG32 _)
-         ->     regAlias r
-
-        -- 8 bit subregs alias the 32 and 16, but not the other 8 bit subreg
-        RegSub SubL8  r@(Reg ClassG32 _)
-         -> mkUniqSet $ [ r, RegSub SubL16 r, RegSub SubL8 r ]
-
-        RegSub SubL8H r@(Reg ClassG32 _)
-         -> mkUniqSet $ [ r, RegSub SubL16 r, RegSub SubL8H r ]
-
-        -- fp
-        Reg ClassF64 _
-         -> unitUniqSet reg
-
-        _ -> error "regAlias: invalid register"
-
-
--- | Optimised versions of RegColorBase.{worst, squeese} specific to x86
-worst :: Int -> RegClass -> RegClass -> Int
-worst n classN classC
- = case classN of
-        ClassG32
-         -> case classC of
-                ClassG32        -> min n 8
-                ClassG16        -> min n 8
-                ClassG8         -> min n 4
-                ClassF64        -> 0
-
-        ClassG16
-         -> case classC of
-                ClassG32        -> min n 8
-                ClassG16        -> min n 8
-                ClassG8         -> min n 4
-                ClassF64        -> 0
-
-        ClassG8
-         -> case classC of
-                ClassG32        -> min (n*2) 8
-                ClassG16        -> min (n*2) 8
-                ClassG8         -> min n 8
-                ClassF64        -> 0
-
-        ClassF64
-         -> case classC of
-                ClassF64        -> min n 6
-                _               -> 0
-
-squeese :: RegClass -> [(Int, RegClass)] -> Int
-squeese classN countCs
-        = sum (map (\(i, classC) -> worst i classN classC) countCs)
-
diff --git a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
deleted file mode 100644
index f42ff9450a..0000000000
--- a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
+++ /dev/null
@@ -1,99 +0,0 @@
--- | Register coalescing.
-module RegAlloc.Graph.Coalesce (
-        regCoalesce,
-        slurpJoinMovs
-) where
-import GhcPrelude
-
-import RegAlloc.Liveness
-import Instruction
-import Reg
-
-import GHC.Cmm
-import Bag
-import Digraph
-import UniqFM
-import UniqSet
-import UniqSupply
-
-
--- | Do register coalescing on this top level thing
---
---   For Reg -> Reg moves, if the first reg dies at the same time the
---   second reg is born then the mov only serves to join live ranges.
---   The two regs can be renamed to be the same and the move instruction
---   safely erased.
-regCoalesce
-        :: Instruction instr
-        => [LiveCmmDecl statics instr]
-        -> UniqSM [LiveCmmDecl statics instr]
-
-regCoalesce code
- = do
-        let joins       = foldl' unionBags emptyBag
-                        $ map slurpJoinMovs code
-
-        let alloc       = foldl' buildAlloc emptyUFM
-                        $ bagToList joins
-
-        let patched     = map (patchEraseLive (sinkReg alloc)) code
-
-        return patched
-
-
--- | Add a v1 = v2 register renaming to the map.
---   The register with the lowest lexical name is set as the
---   canonical version.
-buildAlloc :: UniqFM Reg -> (Reg, Reg) -> UniqFM Reg
-buildAlloc fm (r1, r2)
- = let  rmin    = min r1 r2
-        rmax    = max r1 r2
-   in   addToUFM fm rmax rmin
-
-
--- | Determine the canonical name for a register by following
---   v1 = v2 renamings in this map.
-sinkReg :: UniqFM Reg -> Reg -> Reg
-sinkReg fm r
- = case lookupUFM fm r of
-        Nothing -> r
-        Just r' -> sinkReg fm r'
-
-
--- | Slurp out mov instructions that only serve to join live ranges.
---
---   During a mov, if the source reg dies and the destination reg is
---   born then we can rename the two regs to the same thing and
---   eliminate the move.
-slurpJoinMovs
-        :: Instruction instr
-        => LiveCmmDecl statics instr
-        -> Bag (Reg, Reg)
-
-slurpJoinMovs live
-        = slurpCmm emptyBag live
- where
-        slurpCmm   rs  CmmData{}
-         = rs
-
-        slurpCmm   rs (CmmProc _ _ _ sccs)
-         = foldl' slurpBlock rs (flattenSCCs sccs)
-
-        slurpBlock rs (BasicBlock _ instrs)
-         = foldl' slurpLI    rs instrs
-
-        slurpLI    rs (LiveInstr _      Nothing)    = rs
-        slurpLI    rs (LiveInstr instr (Just live))
-                | Just (r1, r2) <- takeRegRegMoveInstr instr
-                , elementOfUniqSet r1 $ liveDieRead live
-                , elementOfUniqSet r2 $ liveBorn live
-
-                -- only coalesce movs between two virtuals for now,
-                -- else we end up with allocatable regs in the live
-                -- regs list..
-                , isVirtualReg r1 && isVirtualReg r2
-                = consBag (r1, r2) rs
-
-                | otherwise
-                = rs
-
diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs
deleted file mode 100644
index 6b2758f723..0000000000
--- a/compiler/nativeGen/RegAlloc/Graph/Main.hs
+++ /dev/null
@@ -1,472 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
--- | Graph coloring register allocator.
-module RegAlloc.Graph.Main (
-        regAlloc
-) where
-import GhcPrelude
-
-import qualified GraphColor as Color
-import RegAlloc.Liveness
-import RegAlloc.Graph.Spill
-import RegAlloc.Graph.SpillClean
-import RegAlloc.Graph.SpillCost
-import RegAlloc.Graph.Stats
-import RegAlloc.Graph.TrivColorable
-import Instruction
-import TargetReg
-import RegClass
-import Reg
-
-import Bag
-import GHC.Driver.Session
-import Outputable
-import GHC.Platform
-import UniqFM
-import UniqSet
-import UniqSupply
-import Util (seqList)
-import CFG
-
-import Data.Maybe
-import Control.Monad
-
-
--- | The maximum number of build\/spill cycles we'll allow.
---
---   It should only take 3 or 4 cycles for the allocator to converge.
---   If it takes any longer than this it's probably in an infinite loop,
---   so it's better just to bail out and report a bug.
-maxSpinCount    :: Int
-maxSpinCount    = 10
-
-
--- | The top level of the graph coloring register allocator.
-regAlloc
-        :: (Outputable statics, Outputable instr, Instruction instr)
-        => DynFlags
-        -> UniqFM (UniqSet RealReg)     -- ^ registers we can use for allocation
-        -> UniqSet Int                  -- ^ set of available spill slots.
-        -> Int                          -- ^ current number of spill slots
-        -> [LiveCmmDecl statics instr]  -- ^ code annotated with liveness information.
-        -> Maybe CFG                    -- ^ CFG of basic blocks if available
-        -> UniqSM ( [NatCmmDecl statics instr]
-                  , Maybe Int, [RegAllocStats statics instr] )
-           -- ^ code with registers allocated, additional stacks required
-           -- and stats for each stage of allocation
-
-regAlloc dflags regsFree slotsFree slotsCount code cfg
- = do
-        -- TODO: the regClass function is currently hard coded to the default
-        --       target architecture. Would prefer to determine this from dflags.
-        --       There are other uses of targetRegClass later in this module.
-        let platform = targetPlatform dflags
-            triv = trivColorable platform
-                        (targetVirtualRegSqueeze platform)
-                        (targetRealRegSqueeze platform)
-
-        (code_final, debug_codeGraphs, slotsCount', _)
-                <- regAlloc_spin dflags 0
-                        triv
-                        regsFree slotsFree slotsCount [] code cfg
-
-        let needStack
-                | slotsCount == slotsCount'
-                = Nothing
-                | otherwise
-                = Just slotsCount'
-
-        return  ( code_final
-                , needStack
-                , reverse debug_codeGraphs )
-
-
--- | Perform solver iterations for the graph coloring allocator.
---
---   We extract a register conflict graph from the provided cmm code,
---   and try to colour it. If that works then we use the solution rewrite
---   the code with real hregs. If coloring doesn't work we add spill code
---   and try to colour it again. After `maxSpinCount` iterations we give up.
---
-regAlloc_spin
-        :: forall instr statics.
-           (Instruction instr,
-            Outputable instr,
-            Outputable statics)
-        => DynFlags
-        -> Int  -- ^ Number of solver iterations we've already performed.
-        -> Color.Triv VirtualReg RegClass RealReg
-                -- ^ Function for calculating whether a register is trivially
-                --   colourable.
-        -> UniqFM (UniqSet RealReg)      -- ^ Free registers that we can allocate.
-        -> UniqSet Int                   -- ^ Free stack slots that we can use.
-        -> Int                           -- ^ Number of spill slots in use
-        -> [RegAllocStats statics instr] -- ^ Current regalloc stats to add to.
-        -> [LiveCmmDecl statics instr]   -- ^ Liveness annotated code to allocate.
-        -> Maybe CFG
-        -> UniqSM ( [NatCmmDecl statics instr]
-                  , [RegAllocStats statics instr]
-                  , Int                  -- Slots in use
-                  , Color.Graph VirtualReg RegClass RealReg)
-
-regAlloc_spin dflags spinCount triv regsFree slotsFree slotsCount debug_codeGraphs code cfg
- = do
-        let platform = targetPlatform dflags
-
-        -- If any of these dump flags are turned on we want to hang on to
-        -- intermediate structures in the allocator - otherwise tell the
-        -- allocator to ditch them early so we don't end up creating space leaks.
-        let dump = or
-                [ dopt Opt_D_dump_asm_regalloc_stages dflags
-                , dopt Opt_D_dump_asm_stats dflags
-                , dopt Opt_D_dump_asm_conflicts dflags ]
-
-        -- Check that we're not running off down the garden path.
-        when (spinCount > maxSpinCount)
-         $ pprPanic "regAlloc_spin: max build/spill cycle count exceeded."
-           (  text "It looks like the register allocator is stuck in an infinite loop."
-           $$ text "max cycles  = " <> int maxSpinCount
-           $$ text "regsFree    = " <> (hcat $ punctuate space $ map ppr
-                                             $ nonDetEltsUniqSet $ unionManyUniqSets
-                                             $ nonDetEltsUFM regsFree)
-              -- This is non-deterministic but we do not
-              -- currently support deterministic code-generation.
-              -- See Note [Unique Determinism and code generation]
-           $$ text "slotsFree   = " <> ppr (sizeUniqSet slotsFree))
-
-        -- Build the register conflict graph from the cmm code.
-        (graph  :: Color.Graph VirtualReg RegClass RealReg)
-                <- {-# SCC "BuildGraph" #-} buildGraph code
-
-        -- VERY IMPORTANT:
-        --   We really do want the graph to be fully evaluated _before_ we
-        --   start coloring. If we don't do this now then when the call to
-        --   Color.colorGraph forces bits of it, the heap will be filled with
-        --   half evaluated pieces of graph and zillions of apply thunks.
-        seqGraph graph `seq` return ()
-
-        -- Build a map of the cost of spilling each instruction.
-        -- This is a lazy binding, so the map will only be computed if we
-        -- actually have to spill to the stack.
-        let spillCosts  = foldl' plusSpillCostInfo zeroSpillCostInfo
-                        $ map (slurpSpillCostInfo platform cfg) code
-
-        -- The function to choose regs to leave uncolored.
-        let spill       = chooseSpill spillCosts
-
-        -- Record startup state in our log.
-        let stat1
-             = if spinCount == 0
-                 then   Just $ RegAllocStatsStart
-                        { raLiveCmm     = code
-                        , raGraph       = graph
-                        , raSpillCosts  = spillCosts }
-                 else   Nothing
-
-        -- Try and color the graph.
-        let (graph_colored, rsSpill, rmCoalesce)
-                = {-# SCC "ColorGraph" #-}
-                  Color.colorGraph
-                       (gopt Opt_RegsIterative dflags)
-                       spinCount
-                       regsFree triv spill graph
-
-        -- Rewrite registers in the code that have been coalesced.
-        let patchF reg
-                | RegVirtual vr <- reg
-                = case lookupUFM rmCoalesce vr of
-                        Just vr'        -> patchF (RegVirtual vr')
-                        Nothing         -> reg
-
-                | otherwise
-                = reg
-
-        let (code_coalesced :: [LiveCmmDecl statics instr])
-                = map (patchEraseLive patchF) code
-
-        -- Check whether we've found a coloring.
-        if isEmptyUniqSet rsSpill
-
-         -- Coloring was successful because no registers needed to be spilled.
-         then do
-                -- if -fasm-lint is turned on then validate the graph.
-                -- This checks for bugs in the graph allocator itself.
-                let graph_colored_lint  =
-                        if gopt Opt_DoAsmLinting dflags
-                                then Color.validateGraph (text "")
-                                        True    -- Require all nodes to be colored.
-                                        graph_colored
-                                else graph_colored
-
-                -- Rewrite the code to use real hregs, using the colored graph.
-                let code_patched
-                        = map (patchRegsFromGraph platform graph_colored_lint)
-                              code_coalesced
-
-                -- Clean out unneeded SPILL/RELOAD meta instructions.
-                --   The spill code generator just spills the entire live range
-                --   of a vreg, but it might not need to be on the stack for
-                --   its entire lifetime.
-                let code_spillclean
-                        = map (cleanSpills platform) code_patched
-
-                -- Strip off liveness information from the allocated code.
-                -- Also rewrite SPILL/RELOAD meta instructions into real machine
-                -- instructions along the way
-                let code_final
-                        = map (stripLive dflags) code_spillclean
-
-                -- Record what happened in this stage for debugging
-                let stat
-                     =  RegAllocStatsColored
-                        { raCode                = code
-                        , raGraph               = graph
-                        , raGraphColored        = graph_colored_lint
-                        , raCoalesced           = rmCoalesce
-                        , raCodeCoalesced       = code_coalesced
-                        , raPatched             = code_patched
-                        , raSpillClean          = code_spillclean
-                        , raFinal               = code_final
-                        , raSRMs                = foldl' addSRM (0, 0, 0)
-                                                $ map countSRMs code_spillclean }
-
-                -- Bundle up all the register allocator statistics.
-                --   .. but make sure to drop them on the floor if they're not
-                --      needed, otherwise we'll get a space leak.
-                let statList =
-                        if dump then [stat] ++ maybeToList stat1 ++ debug_codeGraphs
-                                else []
-
-                -- Ensure all the statistics are evaluated, to avoid space leaks.
-                seqList statList (return ())
-
-                return  ( code_final
-                        , statList
-                        , slotsCount
-                        , graph_colored_lint)
-
-         -- Coloring was unsuccessful. We need to spill some register to the
-         -- stack, make a new graph, and try to color it again.
-         else do
-                -- if -fasm-lint is turned on then validate the graph
-                let graph_colored_lint  =
-                        if gopt Opt_DoAsmLinting dflags
-                                then Color.validateGraph (text "")
-                                        False   -- don't require nodes to be colored
-                                        graph_colored
-                                else graph_colored
-
-                -- Spill uncolored regs to the stack.
-                (code_spilled, slotsFree', slotsCount', spillStats)
-                        <- regSpill platform code_coalesced slotsFree slotsCount rsSpill
-
-                -- Recalculate liveness information.
-                -- NOTE: we have to reverse the SCCs here to get them back into
-                --       the reverse-dependency order required by computeLiveness.
-                --       If they're not in the correct order that function will panic.
-                code_relive     <- mapM (regLiveness platform . reverseBlocksInTops)
-                                        code_spilled
-
-                -- Record what happened in this stage for debugging.
-                let stat        =
-                        RegAllocStatsSpill
-                        { raCode        = code
-                        , raGraph       = graph_colored_lint
-                        , raCoalesced   = rmCoalesce
-                        , raSpillStats  = spillStats
-                        , raSpillCosts  = spillCosts
-                        , raSpilled     = code_spilled }
-
-                -- Bundle up all the register allocator statistics.
-                --   .. but make sure to drop them on the floor if they're not
-                --      needed, otherwise we'll get a space leak.
-                let statList =
-                        if dump
-                                then [stat] ++ maybeToList stat1 ++ debug_codeGraphs
-                                else []
-
-                -- Ensure all the statistics are evaluated, to avoid space leaks.
-                seqList statList (return ())
-
-                regAlloc_spin dflags (spinCount + 1) triv regsFree slotsFree'
-                              slotsCount' statList code_relive cfg
-
-
--- | Build a graph from the liveness and coalesce information in this code.
-buildGraph
-        :: Instruction instr
-        => [LiveCmmDecl statics instr]
-        -> UniqSM (Color.Graph VirtualReg RegClass RealReg)
-
-buildGraph code
- = do
-        -- Slurp out the conflicts and reg->reg moves from this code.
-        let (conflictList, moveList) =
-                unzip $ map slurpConflicts code
-
-        -- Slurp out the spill/reload coalesces.
-        let moveList2           = map slurpReloadCoalesce code
-
-        -- Add the reg-reg conflicts to the graph.
-        let conflictBag         = unionManyBags conflictList
-        let graph_conflict
-                = foldr graphAddConflictSet Color.initGraph conflictBag
-
-        -- Add the coalescences edges to the graph.
-        let moveBag
-                = unionBags (unionManyBags moveList2)
-                            (unionManyBags moveList)
-
-        let graph_coalesce
-                = foldr graphAddCoalesce graph_conflict moveBag
-
-        return  graph_coalesce
-
-
--- | Add some conflict edges to the graph.
---   Conflicts between virtual and real regs are recorded as exclusions.
-graphAddConflictSet
-        :: UniqSet Reg
-        -> Color.Graph VirtualReg RegClass RealReg
-        -> Color.Graph VirtualReg RegClass RealReg
-
-graphAddConflictSet set graph
- = let  virtuals        = mkUniqSet
-                        [ vr | RegVirtual vr <- nonDetEltsUniqSet set ]
-
-        graph1  = Color.addConflicts virtuals classOfVirtualReg graph
-
-        graph2  = foldr (\(r1, r2) -> Color.addExclusion r1 classOfVirtualReg r2)
-                        graph1
-                        [ (vr, rr)
-                                | RegVirtual vr <- nonDetEltsUniqSet set
-                                , RegReal    rr <- nonDetEltsUniqSet set]
-                          -- See Note [Unique Determinism and code generation]
-
-   in   graph2
-
-
--- | Add some coalesence edges to the graph
---   Coalesences between virtual and real regs are recorded as preferences.
-graphAddCoalesce
-        :: (Reg, Reg)
-        -> Color.Graph VirtualReg RegClass RealReg
-        -> Color.Graph VirtualReg RegClass RealReg
-
-graphAddCoalesce (r1, r2) graph
-        | RegReal rr            <- r1
-        , RegVirtual vr         <- r2
-        = Color.addPreference (vr, classOfVirtualReg vr) rr graph
-
-        | RegReal rr            <- r2
-        , RegVirtual vr         <- r1
-        = Color.addPreference (vr, classOfVirtualReg vr) rr graph
-
-        | RegVirtual vr1        <- r1
-        , RegVirtual vr2        <- r2
-        = Color.addCoalesce
-                (vr1, classOfVirtualReg vr1)
-                (vr2, classOfVirtualReg vr2)
-                graph
-
-        -- We can't coalesce two real regs, but there could well be existing
-        --      hreg,hreg moves in the input code. We'll just ignore these
-        --      for coalescing purposes.
-        | RegReal _             <- r1
-        , RegReal _             <- r2
-        = graph
-
-#if __GLASGOW_HASKELL__ <= 810
-        | otherwise
-        = panic "graphAddCoalesce"
-#endif
-
-
--- | Patch registers in code using the reg -> reg mapping in this graph.
-patchRegsFromGraph
-        :: (Outputable statics, Outputable instr, Instruction instr)
-        => Platform -> Color.Graph VirtualReg RegClass RealReg
-        -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
-
-patchRegsFromGraph platform graph code
- = patchEraseLive patchF code
- where
-        -- Function to lookup the hardreg for a virtual reg from the graph.
-        patchF reg
-                -- leave real regs alone.
-                | RegReal{}     <- reg
-                = reg
-
-                -- this virtual has a regular node in the graph.
-                | RegVirtual vr <- reg
-                , Just node     <- Color.lookupNode graph vr
-                = case Color.nodeColor node of
-                        Just color      -> RegReal    color
-                        Nothing         -> RegVirtual vr
-
-                -- no node in the graph for this virtual, bad news.
-                | otherwise
-                = pprPanic "patchRegsFromGraph: register mapping failed."
-                        (  text "There is no node in the graph for register "
-                                <> ppr reg
-                        $$ ppr code
-                        $$ Color.dotGraph
-                                (\_ -> text "white")
-                                (trivColorable platform
-                                        (targetVirtualRegSqueeze platform)
-                                        (targetRealRegSqueeze platform))
-                                graph)
-
-
------
--- for when laziness just isn't what you wanted...
---  We need to deepSeq the whole graph before trying to colour it to avoid
---  space leaks.
-seqGraph :: Color.Graph VirtualReg RegClass RealReg -> ()
-seqGraph graph          = seqNodes (nonDetEltsUFM (Color.graphMap graph))
-   -- See Note [Unique Determinism and code generation]
-
-seqNodes :: [Color.Node VirtualReg RegClass RealReg] -> ()
-seqNodes ns
- = case ns of
-        []              -> ()
-        (n : ns)        -> seqNode n `seq` seqNodes ns
-
-seqNode :: Color.Node VirtualReg RegClass RealReg -> ()
-seqNode node
-        =     seqVirtualReg     (Color.nodeId node)
-        `seq` seqRegClass       (Color.nodeClass node)
-        `seq` seqMaybeRealReg   (Color.nodeColor node)
-        `seq` (seqVirtualRegList (nonDetEltsUniqSet (Color.nodeConflicts node)))
-        `seq` (seqRealRegList    (nonDetEltsUniqSet (Color.nodeExclusions node)))
-        `seq` (seqRealRegList (Color.nodePreference node))
-        `seq` (seqVirtualRegList (nonDetEltsUniqSet (Color.nodeCoalesce node)))
-              -- It's OK to use nonDetEltsUniqSet for seq
-
-seqVirtualReg :: VirtualReg -> ()
-seqVirtualReg reg = reg `seq` ()
-
-seqRealReg :: RealReg -> ()
-seqRealReg reg = reg `seq` ()
-
-seqRegClass :: RegClass -> ()
-seqRegClass c = c `seq` ()
-
-seqMaybeRealReg :: Maybe RealReg -> ()
-seqMaybeRealReg mr
- = case mr of
-        Nothing         -> ()
-        Just r          -> seqRealReg r
-
-seqVirtualRegList :: [VirtualReg] -> ()
-seqVirtualRegList rs
- = case rs of
-        []              -> ()
-        (r : rs)        -> seqVirtualReg r `seq` seqVirtualRegList rs
-
-seqRealRegList :: [RealReg] -> ()
-seqRealRegList rs
- = case rs of
-        []              -> ()
-        (r : rs)        -> seqRealReg r `seq` seqRealRegList rs
diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
deleted file mode 100644
index 9ffb51ee29..0000000000
--- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs
+++ /dev/null
@@ -1,382 +0,0 @@
-
--- | When there aren't enough registers to hold all the vregs we have to spill
---   some of those vregs to slots on the stack. This module is used modify the
---   code to use those slots.
-module RegAlloc.Graph.Spill (
-        regSpill,
-        SpillStats(..),
-        accSpillSL
-) where
-import GhcPrelude
-
-import RegAlloc.Liveness
-import Instruction
-import Reg
-import GHC.Cmm hiding (RegSet)
-import GHC.Cmm.BlockId
-import GHC.Cmm.Dataflow.Collections
-
-import MonadUtils
-import State
-import Unique
-import UniqFM
-import UniqSet
-import UniqSupply
-import Outputable
-import GHC.Platform
-
-import Data.List
-import Data.Maybe
-import Data.IntSet              (IntSet)
-import qualified Data.IntSet    as IntSet
-
-
--- | Spill all these virtual regs to stack slots.
---
---   Bumps the number of required stack slots if required.
---
---
---   TODO: See if we can split some of the live ranges instead of just globally
---         spilling the virtual reg. This might make the spill cleaner's job easier.
---
---   TODO: On CISCy x86 and x86_64 we don't necessarily have to add a mov instruction
---         when making spills. If an instr is using a spilled virtual we may be able to
---         address the spill slot directly.
---
-regSpill
-        :: Instruction instr
-        => Platform
-        -> [LiveCmmDecl statics instr]  -- ^ the code
-        -> UniqSet Int                  -- ^ available stack slots
-        -> Int                          -- ^ current number of spill slots.
-        -> UniqSet VirtualReg           -- ^ the regs to spill
-        -> UniqSM
-            ([LiveCmmDecl statics instr]
-                 -- code with SPILL and RELOAD meta instructions added.
-            , UniqSet Int               -- left over slots
-            , Int                       -- slot count in use now.
-            , SpillStats )              -- stats about what happened during spilling
-
-regSpill platform code slotsFree slotCount regs
-
-        -- Not enough slots to spill these regs.
-        | sizeUniqSet slotsFree < sizeUniqSet regs
-        = -- pprTrace "Bumping slot count:" (ppr slotCount <> text " -> " <> ppr (slotCount+512)) $
-          let slotsFree' = (addListToUniqSet slotsFree [slotCount+1 .. slotCount+512])
-          in regSpill platform code slotsFree' (slotCount+512) regs
-
-        | otherwise
-        = do
-                -- Allocate a slot for each of the spilled regs.
-                let slots       = take (sizeUniqSet regs) $ nonDetEltsUniqSet slotsFree
-                let regSlotMap  = listToUFM
-                                $ zip (nonDetEltsUniqSet regs) slots
-                    -- This is non-deterministic but we do not
-                    -- currently support deterministic code-generation.
-                    -- See Note [Unique Determinism and code generation]
-
-                -- Grab the unique supply from the monad.
-                us      <- getUniqueSupplyM
-
-                -- Run the spiller on all the blocks.
-                let (code', state')     =
-                        runState (mapM (regSpill_top platform regSlotMap) code)
-                                 (initSpillS us)
-
-                return  ( code'
-                        , minusUniqSet slotsFree (mkUniqSet slots)
-                        , slotCount
-                        , makeSpillStats state')
-
-
--- | Spill some registers to stack slots in a top-level thing.
-regSpill_top
-        :: Instruction instr
-        => Platform
-        -> RegMap Int
-                -- ^ map of vregs to slots they're being spilled to.
-        -> LiveCmmDecl statics instr
-                -- ^ the top level thing.
-        -> SpillM (LiveCmmDecl statics instr)
-
-regSpill_top platform regSlotMap cmm
- = case cmm of
-        CmmData{}
-         -> return cmm
-
-        CmmProc info label live sccs
-         |  LiveInfo static firstId liveVRegsOnEntry liveSlotsOnEntry <- info
-         -> do
-                -- The liveVRegsOnEntry contains the set of vregs that are live
-                -- on entry to each basic block. If we spill one of those vregs
-                -- we remove it from that set and add the corresponding slot
-                -- number to the liveSlotsOnEntry set. The spill cleaner needs
-                -- this information to erase unneeded spill and reload instructions
-                -- after we've done a successful allocation.
-                let liveSlotsOnEntry' :: BlockMap IntSet
-                    liveSlotsOnEntry'
-                        = mapFoldlWithKey patchLiveSlot
-                                          liveSlotsOnEntry liveVRegsOnEntry
-
-                let info'
-                        = LiveInfo static firstId
-                                liveVRegsOnEntry
-                                liveSlotsOnEntry'
-
-                -- Apply the spiller to all the basic blocks in the CmmProc.
-                sccs'   <- mapM (mapSCCM (regSpill_block platform regSlotMap)) sccs
-
-                return  $ CmmProc info' label live sccs'
-
- where  -- Given a BlockId and the set of registers live in it,
-        -- if registers in this block are being spilled to stack slots,
-        -- then record the fact that these slots are now live in those blocks
-        -- in the given slotmap.
-        patchLiveSlot
-                :: BlockMap IntSet -> BlockId -> RegSet -> BlockMap IntSet
-
-        patchLiveSlot slotMap blockId regsLive
-         = let
-                -- Slots that are already recorded as being live.
-                curSlotsLive    = fromMaybe IntSet.empty
-                                $ mapLookup blockId slotMap
-
-                moreSlotsLive   = IntSet.fromList
-                                $ catMaybes
-                                $ map (lookupUFM regSlotMap)
-                                $ nonDetEltsUniqSet regsLive
-                    -- See Note [Unique Determinism and code generation]
-
-                slotMap'
-                 = mapInsert blockId (IntSet.union curSlotsLive moreSlotsLive)
-                             slotMap
-
-           in   slotMap'
-
-
--- | Spill some registers to stack slots in a basic block.
-regSpill_block
-        :: Instruction instr
-        => Platform
-        -> UniqFM Int   -- ^ map of vregs to slots they're being spilled to.
-        -> LiveBasicBlock instr
-        -> SpillM (LiveBasicBlock instr)
-
-regSpill_block platform regSlotMap (BasicBlock i instrs)
- = do   instrss'        <- mapM (regSpill_instr platform regSlotMap) instrs
-        return  $ BasicBlock i (concat instrss')
-
-
--- | Spill some registers to stack slots in a single instruction.
---   If the instruction uses registers that need to be spilled, then it is
---   prefixed (or postfixed) with the appropriate RELOAD or SPILL meta
---   instructions.
-regSpill_instr
-        :: Instruction instr
-        => Platform
-        -> UniqFM Int -- ^ map of vregs to slots they're being spilled to.
-        -> LiveInstr instr
-        -> SpillM [LiveInstr instr]
-
-regSpill_instr _ _ li@(LiveInstr _ Nothing)
- = do   return [li]
-
-regSpill_instr platform regSlotMap
-        (LiveInstr instr (Just _))
- = do
-        -- work out which regs are read and written in this instr
-        let RU rlRead rlWritten = regUsageOfInstr platform instr
-
-        -- sometimes a register is listed as being read more than once,
-        --      nub this so we don't end up inserting two lots of spill code.
-        let rsRead_             = nub rlRead
-        let rsWritten_          = nub rlWritten
-
-        -- if a reg is modified, it appears in both lists, want to undo this..
-        let rsRead              = rsRead_    \\ rsWritten_
-        let rsWritten           = rsWritten_ \\ rsRead_
-        let rsModify            = intersect rsRead_ rsWritten_
-
-        -- work out if any of the regs being used are currently being spilled.
-        let rsSpillRead         = filter (\r -> elemUFM r regSlotMap) rsRead
-        let rsSpillWritten      = filter (\r -> elemUFM r regSlotMap) rsWritten
-        let rsSpillModify       = filter (\r -> elemUFM r regSlotMap) rsModify
-
-        -- rewrite the instr and work out spill code.
-        (instr1, prepost1)      <- mapAccumLM (spillRead   regSlotMap) instr  rsSpillRead
-        (instr2, prepost2)      <- mapAccumLM (spillWrite  regSlotMap) instr1 rsSpillWritten
-        (instr3, prepost3)      <- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify
-
-        let (mPrefixes, mPostfixes)     = unzip (prepost1 ++ prepost2 ++ prepost3)
-        let prefixes                    = concat mPrefixes
-        let postfixes                   = concat mPostfixes
-
-        -- final code
-        let instrs'     =  prefixes
-                        ++ [LiveInstr instr3 Nothing]
-                        ++ postfixes
-
-        return $ instrs'
-
-
--- | Add a RELOAD met a instruction to load a value for an instruction that
---   writes to a vreg that is being spilled.
-spillRead
-        :: Instruction instr
-        => UniqFM Int
-        -> instr
-        -> Reg
-        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
-
-spillRead regSlotMap instr reg
- | Just slot     <- lookupUFM regSlotMap reg
- = do    (instr', nReg)  <- patchInstr reg instr
-
-         modify $ \s -> s
-                { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
-
-         return  ( instr'
-                 , ( [LiveInstr (RELOAD slot nReg) Nothing]
-                 , []) )
-
- | otherwise     = panic "RegSpill.spillRead: no slot defined for spilled reg"
-
-
--- | Add a SPILL meta instruction to store a value for an instruction that
---   writes to a vreg that is being spilled.
-spillWrite
-        :: Instruction instr
-        => UniqFM Int
-        -> instr
-        -> Reg
-        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
-
-spillWrite regSlotMap instr reg
- | Just slot     <- lookupUFM regSlotMap reg
- = do    (instr', nReg)  <- patchInstr reg instr
-
-         modify $ \s -> s
-                { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
-
-         return  ( instr'
-                 , ( []
-                   , [LiveInstr (SPILL nReg slot) Nothing]))
-
- | otherwise     = panic "RegSpill.spillWrite: no slot defined for spilled reg"
-
-
--- | Add both RELOAD and SPILL meta instructions for an instruction that
---   both reads and writes to a vreg that is being spilled.
-spillModify
-        :: Instruction instr
-        => UniqFM Int
-        -> instr
-        -> Reg
-        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
-
-spillModify regSlotMap instr reg
- | Just slot     <- lookupUFM regSlotMap reg
- = do    (instr', nReg)  <- patchInstr reg instr
-
-         modify $ \s -> s
-                { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
-
-         return  ( instr'
-                 , ( [LiveInstr (RELOAD slot nReg) Nothing]
-                   , [LiveInstr (SPILL nReg slot) Nothing]))
-
- | otherwise     = panic "RegSpill.spillModify: no slot defined for spilled reg"
-
-
--- | Rewrite uses of this virtual reg in an instr to use a different
---   virtual reg.
-patchInstr
-        :: Instruction instr
-        => Reg -> instr -> SpillM (instr, Reg)
-
-patchInstr reg instr
- = do   nUnique         <- newUnique
-
-        -- The register we're rewriting is supposed to be virtual.
-        -- If it's not then something has gone horribly wrong.
-        let nReg
-             = case reg of
-                RegVirtual vr
-                 -> RegVirtual (renameVirtualReg nUnique vr)
-
-                RegReal{}
-                 -> panic "RegAlloc.Graph.Spill.patchIntr: not patching real reg"
-
-        let instr'      = patchReg1 reg nReg instr
-        return          (instr', nReg)
-
-
-patchReg1
-        :: Instruction instr
-        => Reg -> Reg -> instr -> instr
-
-patchReg1 old new instr
- = let  patchF r
-                | r == old      = new
-                | otherwise     = r
-   in   patchRegsOfInstr instr patchF
-
-
--- Spiller monad --------------------------------------------------------------
--- | State monad for the spill code generator.
-type SpillM a
-        = State SpillS a
-
--- | Spill code generator state.
-data SpillS
-        = SpillS
-        { -- | Unique supply for generating fresh vregs.
-          stateUS       :: UniqSupply
-
-          -- | Spilled vreg vs the number of times it was loaded, stored.
-        , stateSpillSL  :: UniqFM (Reg, Int, Int) }
-
-
--- | Create a new spiller state.
-initSpillS :: UniqSupply -> SpillS
-initSpillS uniqueSupply
-        = SpillS
-        { stateUS       = uniqueSupply
-        , stateSpillSL  = emptyUFM }
-
-
--- | Allocate a new unique in the spiller monad.
-newUnique :: SpillM Unique
-newUnique
- = do   us      <- gets stateUS
-        case takeUniqFromSupply us of
-         (uniq, us')
-          -> do modify $ \s -> s { stateUS = us' }
-                return uniq
-
-
--- | Add a spill/reload count to a stats record for a register.
-accSpillSL :: (Reg, Int, Int) -> (Reg, Int, Int) -> (Reg, Int, Int)
-accSpillSL (r1, s1, l1) (_, s2, l2)
-        = (r1, s1 + s2, l1 + l2)
-
-
--- Spiller stats --------------------------------------------------------------
--- | Spiller statistics.
---   Tells us what registers were spilled.
-data SpillStats
-        = SpillStats
-        { spillStoreLoad        :: UniqFM (Reg, Int, Int) }
-
-
--- | Extract spiller statistics from the spiller state.
-makeSpillStats :: SpillS -> SpillStats
-makeSpillStats s
-        = SpillStats
-        { spillStoreLoad        = stateSpillSL s }
-
-
-instance Outputable SpillStats where
- ppr stats
-        = pprUFM (spillStoreLoad stats)
-                 (vcat . map (\(r, s, l) -> ppr r <+> int s <+> int l))
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
deleted file mode 100644
index bd8b449cbb..0000000000
--- a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
+++ /dev/null
@@ -1,616 +0,0 @@
-{-# LANGUAGE CPP #-}
-
--- | Clean out unneeded spill\/reload instructions.
---
---   Handling of join points
---   ~~~~~~~~~~~~~~~~~~~~~~~
---
---   B1:                          B2:
---    ...                          ...
---       RELOAD SLOT(0), %r1          RELOAD SLOT(0), %r1
---       ... A ...                    ... B ...
---       jump B3                      jump B3
---
---                B3: ... C ...
---                    RELOAD SLOT(0), %r1
---                    ...
---
---   The Plan
---   ~~~~~~~~
---   As long as %r1 hasn't been written to in A, B or C then we don't need
---   the reload in B3.
---
---   What we really care about here is that on the entry to B3, %r1 will
---   always have the same value that is in SLOT(0) (ie, %r1 is _valid_)
---
---   This also works if the reloads in B1\/B2 were spills instead, because
---   spilling %r1 to a slot makes that slot have the same value as %r1.
---
-module RegAlloc.Graph.SpillClean (
-        cleanSpills
-) where
-import GhcPrelude
-
-import RegAlloc.Liveness
-import Instruction
-import Reg
-
-import GHC.Cmm.BlockId
-import GHC.Cmm
-import UniqSet
-import UniqFM
-import Unique
-import State
-import Outputable
-import GHC.Platform
-import GHC.Cmm.Dataflow.Collections
-
-import Data.List
-import Data.Maybe
-import Data.IntSet              (IntSet)
-import qualified Data.IntSet    as IntSet
-
-
--- | The identification number of a spill slot.
---   A value is stored in a spill slot when we don't have a free
---   register to hold it.
-type Slot = Int
-
-
--- | Clean out unneeded spill\/reloads from this top level thing.
-cleanSpills
-        :: Instruction instr
-        => Platform
-        -> LiveCmmDecl statics instr
-        -> LiveCmmDecl statics instr
-
-cleanSpills platform cmm
-        = evalState (cleanSpin platform 0 cmm) initCleanS
-
-
--- | Do one pass of cleaning.
-cleanSpin
-        :: Instruction instr
-        => Platform
-        -> Int                              -- ^ Iteration number for the cleaner.
-        -> LiveCmmDecl statics instr        -- ^ Liveness annotated code to clean.
-        -> CleanM (LiveCmmDecl statics instr)
-
-cleanSpin platform spinCount code
- = do
-        -- Initialise count of cleaned spill and reload instructions.
-        modify $ \s -> s
-                { sCleanedSpillsAcc     = 0
-                , sCleanedReloadsAcc    = 0
-                , sReloadedBy           = emptyUFM }
-
-        code_forward    <- mapBlockTopM (cleanBlockForward platform) code
-        code_backward   <- cleanTopBackward code_forward
-
-        -- During the cleaning of each block we collected information about
-        -- what regs were valid across each jump. Based on this, work out
-        -- whether it will be safe to erase reloads after join points for
-        -- the next pass.
-        collateJoinPoints
-
-        -- Remember how many spill and reload instructions we cleaned in this pass.
-        spills          <- gets sCleanedSpillsAcc
-        reloads         <- gets sCleanedReloadsAcc
-        modify $ \s -> s
-                { sCleanedCount = (spills, reloads) : sCleanedCount s }
-
-        -- If nothing was cleaned in this pass or the last one
-        --      then we're done and it's time to bail out.
-        cleanedCount    <- gets sCleanedCount
-        if take 2 cleanedCount == [(0, 0), (0, 0)]
-           then return code
-
-        -- otherwise go around again
-           else cleanSpin platform (spinCount + 1) code_backward
-
-
--------------------------------------------------------------------------------
--- | Clean out unneeded reload instructions,
---   while walking forward over the code.
-cleanBlockForward
-        :: Instruction instr
-        => Platform
-        -> LiveBasicBlock instr
-        -> CleanM (LiveBasicBlock instr)
-
-cleanBlockForward platform (BasicBlock blockId instrs)
- = do
-        -- See if we have a valid association for the entry to this block.
-        jumpValid       <- gets sJumpValid
-        let assoc       = case lookupUFM jumpValid blockId of
-                                Just assoc      -> assoc
-                                Nothing         -> emptyAssoc
-
-        instrs_reload   <- cleanForward platform blockId assoc [] instrs
-        return  $ BasicBlock blockId instrs_reload
-
-
-
--- | Clean out unneeded reload instructions.
---
---   Walking forwards across the code
---     On a reload, if we know a reg already has the same value as a slot
---     then we don't need to do the reload.
---
-cleanForward
-        :: Instruction instr
-        => Platform
-        -> BlockId                  -- ^ the block that we're currently in
-        -> Assoc Store              -- ^ two store locations are associated if
-                                    --     they have the same value
-        -> [LiveInstr instr]        -- ^ acc
-        -> [LiveInstr instr]        -- ^ instrs to clean (in backwards order)
-        -> CleanM [LiveInstr instr] -- ^ cleaned instrs  (in forward   order)
-
-cleanForward _ _ _ acc []
-        = return acc
-
--- Rewrite live range joins via spill slots to just a spill and a reg-reg move
--- hopefully the spill will be also be cleaned in the next pass
-cleanForward platform blockId assoc acc (li1 : li2 : instrs)
-
-        | LiveInstr (SPILL  reg1  slot1) _      <- li1
-        , LiveInstr (RELOAD slot2 reg2)  _      <- li2
-        , slot1 == slot2
-        = do
-                modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
-                cleanForward platform blockId assoc acc
-                 $ li1 : LiveInstr (mkRegRegMoveInstr platform reg1 reg2) Nothing
-                       : instrs
-
-cleanForward platform blockId assoc acc (li@(LiveInstr i1 _) : instrs)
-        | Just (r1, r2) <- takeRegRegMoveInstr i1
-        = if r1 == r2
-                -- Erase any left over nop reg reg moves while we're here
-                -- this will also catch any nop moves that the previous case
-                -- happens to add.
-                then cleanForward platform blockId assoc acc instrs
-
-                -- If r1 has the same value as some slots and we copy r1 to r2,
-                --      then r2 is now associated with those slots instead
-                else do let assoc'      = addAssoc (SReg r1) (SReg r2)
-                                        $ delAssoc (SReg r2)
-                                        $ assoc
-
-                        cleanForward platform blockId assoc' (li : acc) instrs
-
-
-cleanForward platform blockId assoc acc (li : instrs)
-
-        -- Update association due to the spill.
-        | LiveInstr (SPILL reg slot) _  <- li
-        = let   assoc'  = addAssoc (SReg reg)  (SSlot slot)
-                        $ delAssoc (SSlot slot)
-                        $ assoc
-          in    cleanForward platform blockId assoc' (li : acc) instrs
-
-        -- Clean a reload instr.
-        | LiveInstr (RELOAD{}) _        <- li
-        = do    (assoc', mli)   <- cleanReload platform blockId assoc li
-                case mli of
-                 Nothing        -> cleanForward platform blockId assoc' acc
-                                                instrs
-
-                 Just li'       -> cleanForward platform blockId assoc' (li' : acc)
-                                                instrs
-
-        -- Remember the association over a jump.
-        | LiveInstr instr _     <- li
-        , targets               <- jumpDestsOfInstr instr
-        , not $ null targets
-        = do    mapM_ (accJumpValid assoc) targets
-                cleanForward platform blockId assoc (li : acc) instrs
-
-        -- Writing to a reg changes its value.
-        | LiveInstr instr _     <- li
-        , RU _ written          <- regUsageOfInstr platform instr
-        = let assoc'    = foldr delAssoc assoc (map SReg $ nub written)
-          in  cleanForward platform blockId assoc' (li : acc) instrs
-
-
-
--- | Try and rewrite a reload instruction to something more pleasing
-cleanReload
-        :: Instruction instr
-        => Platform
-        -> BlockId
-        -> Assoc Store
-        -> LiveInstr instr
-        -> CleanM (Assoc Store, Maybe (LiveInstr instr))
-
-cleanReload platform blockId assoc li@(LiveInstr (RELOAD slot reg) _)
-
-        -- If the reg we're reloading already has the same value as the slot
-        --      then we can erase the instruction outright.
-        | elemAssoc (SSlot slot) (SReg reg) assoc
-        = do    modify  $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
-                return  (assoc, Nothing)
-
-        -- If we can find another reg with the same value as this slot then
-        --      do a move instead of a reload.
-        | Just reg2     <- findRegOfSlot assoc slot
-        = do    modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
-
-                let assoc'      = addAssoc (SReg reg) (SReg reg2)
-                                $ delAssoc (SReg reg)
-                                $ assoc
-
-                return  ( assoc'
-                        , Just $ LiveInstr (mkRegRegMoveInstr platform reg2 reg) Nothing)
-
-        -- Gotta keep this instr.
-        | otherwise
-        = do    -- Update the association.
-                let assoc'
-                        = addAssoc (SReg reg)  (SSlot slot)
-                                -- doing the reload makes reg and slot the same value
-                        $ delAssoc (SReg reg)
-                                -- reg value changes on reload
-                        $ assoc
-
-                -- Remember that this block reloads from this slot.
-                accBlockReloadsSlot blockId slot
-
-                return  (assoc', Just li)
-
-cleanReload _ _ _ _
-        = panic "RegSpillClean.cleanReload: unhandled instr"
-
-
--------------------------------------------------------------------------------
--- | Clean out unneeded spill instructions,
---   while walking backwards over the code.
---
---      If there were no reloads from a slot between a spill and the last one
---      then the slot was never read and we don't need the spill.
---
---      SPILL   r0 -> s1
---      RELOAD  s1 -> r2
---      SPILL   r3 -> s1        <--- don't need this spill
---      SPILL   r4 -> s1
---      RELOAD  s1 -> r5
---
---      Maintain a set of
---              "slots which were spilled to but not reloaded from yet"
---
---      Walking backwards across the code:
---       a) On a reload from a slot, remove it from the set.
---
---       a) On a spill from a slot
---              If the slot is in set then we can erase the spill,
---               because it won't be reloaded from until after the next spill.
---
---              otherwise
---               keep the spill and add the slot to the set
---
--- TODO: This is mostly inter-block
---       we should really be updating the noReloads set as we cross jumps also.
---
--- TODO: generate noReloads from liveSlotsOnEntry
---
-cleanTopBackward
-        :: Instruction instr
-        => LiveCmmDecl statics instr
-        -> CleanM (LiveCmmDecl statics instr)
-
-cleanTopBackward cmm
- = case cmm of
-        CmmData{}
-         -> return cmm
-
-        CmmProc info label live sccs
-         | LiveInfo _ _ _ liveSlotsOnEntry <- info
-         -> do  sccs'   <- mapM (mapSCCM (cleanBlockBackward liveSlotsOnEntry)) sccs
-                return  $ CmmProc info label live sccs'
-
-
-cleanBlockBackward
-        :: Instruction instr
-        => BlockMap IntSet
-        -> LiveBasicBlock instr
-        -> CleanM (LiveBasicBlock instr)
-
-cleanBlockBackward liveSlotsOnEntry (BasicBlock blockId instrs)
- = do   instrs_spill    <- cleanBackward liveSlotsOnEntry  emptyUniqSet  [] instrs
-        return  $ BasicBlock blockId instrs_spill
-
-
-
-cleanBackward
-        :: Instruction instr
-        => BlockMap IntSet          -- ^ Slots live on entry to each block
-        -> UniqSet Int              -- ^ Slots that have been spilled, but not reloaded from
-        -> [LiveInstr instr]        -- ^ acc
-        -> [LiveInstr instr]        -- ^ Instrs to clean (in forwards order)
-        -> CleanM [LiveInstr instr] -- ^ Cleaned instrs  (in backwards order)
-
-cleanBackward liveSlotsOnEntry noReloads acc lis
- = do   reloadedBy      <- gets sReloadedBy
-        cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc lis
-
-
-cleanBackward'
-        :: Instruction instr
-        => BlockMap IntSet
-        -> UniqFM [BlockId]
-        -> UniqSet Int
-        -> [LiveInstr instr]
-        -> [LiveInstr instr]
-        -> State CleanS [LiveInstr instr]
-
-cleanBackward' _ _ _      acc []
-        = return  acc
-
-cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc (li : instrs)
-
-        -- If nothing ever reloads from this slot then we don't need the spill.
-        | LiveInstr (SPILL _ slot) _    <- li
-        , Nothing       <- lookupUFM reloadedBy (SSlot slot)
-        = do    modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
-                cleanBackward liveSlotsOnEntry noReloads acc instrs
-
-        | LiveInstr (SPILL _ slot) _    <- li
-        = if elementOfUniqSet slot noReloads
-
-           -- We can erase this spill because the slot won't be read until
-           -- after the next one
-           then do
-                modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
-                cleanBackward liveSlotsOnEntry noReloads acc instrs
-
-           else do
-                -- This slot is being spilled to, but we haven't seen any reloads yet.
-                let noReloads'  = addOneToUniqSet noReloads slot
-                cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
-
-        -- if we reload from a slot then it's no longer unused
-        | LiveInstr (RELOAD slot _) _   <- li
-        , noReloads'            <- delOneFromUniqSet noReloads slot
-        = cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
-
-        -- If a slot is live in a jump target then assume it's reloaded there.
-        --
-        -- TODO: A real dataflow analysis would do a better job here.
-        --       If the target block _ever_ used the slot then we assume
-        --       it always does, but if those reloads are cleaned the slot
-        --       liveness map doesn't get updated.
-        | LiveInstr instr _     <- li
-        , targets               <- jumpDestsOfInstr instr
-        = do
-                let slotsReloadedByTargets
-                        = IntSet.unions
-                        $ catMaybes
-                        $ map (flip mapLookup liveSlotsOnEntry)
-                        $ targets
-
-                let noReloads'
-                        = foldl' delOneFromUniqSet noReloads
-                        $ IntSet.toList slotsReloadedByTargets
-
-                cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
-
-#if __GLASGOW_HASKELL__ <= 810
-        -- some other instruction
-        | otherwise
-        = cleanBackward liveSlotsOnEntry noReloads (li : acc) instrs
-#endif
-
-
--- | Combine the associations from all the inward control flow edges.
---
-collateJoinPoints :: CleanM ()
-collateJoinPoints
- = modify $ \s -> s
-        { sJumpValid    = mapUFM intersects (sJumpValidAcc s)
-        , sJumpValidAcc = emptyUFM }
-
-intersects :: [Assoc Store]     -> Assoc Store
-intersects []           = emptyAssoc
-intersects assocs       = foldl1' intersectAssoc assocs
-
-
--- | See if we have a reg with the same value as this slot in the association table.
-findRegOfSlot :: Assoc Store -> Int -> Maybe Reg
-findRegOfSlot assoc slot
-        | close                 <- closeAssoc (SSlot slot) assoc
-        , Just (SReg reg)       <- find isStoreReg $ nonDetEltsUniqSet close
-           -- See Note [Unique Determinism and code generation]
-        = Just reg
-
-        | otherwise
-        = Nothing
-
-
--------------------------------------------------------------------------------
--- | Cleaner monad.
-type CleanM
-        = State CleanS
-
--- | Cleaner state.
-data CleanS
-        = CleanS
-        { -- | Regs which are valid at the start of each block.
-          sJumpValid            :: UniqFM (Assoc Store)
-
-          -- | Collecting up what regs were valid across each jump.
-          --    in the next pass we can collate these and write the results
-          --    to sJumpValid.
-        , sJumpValidAcc         :: UniqFM [Assoc Store]
-
-          -- | Map of (slot -> blocks which reload from this slot)
-          --    used to decide if whether slot spilled to will ever be
-          --    reloaded from on this path.
-        , sReloadedBy           :: UniqFM [BlockId]
-
-          -- | Spills and reloads cleaned each pass (latest at front)
-        , sCleanedCount         :: [(Int, Int)]
-
-          -- | Spills and reloads that have been cleaned in this pass so far.
-        , sCleanedSpillsAcc     :: Int
-        , sCleanedReloadsAcc    :: Int }
-
-
--- | Construct the initial cleaner state.
-initCleanS :: CleanS
-initCleanS
-        = CleanS
-        { sJumpValid            = emptyUFM
-        , sJumpValidAcc         = emptyUFM
-
-        , sReloadedBy           = emptyUFM
-
-        , sCleanedCount         = []
-
-        , sCleanedSpillsAcc     = 0
-        , sCleanedReloadsAcc    = 0 }
-
-
--- | Remember the associations before a jump.
-accJumpValid :: Assoc Store -> BlockId -> CleanM ()
-accJumpValid assocs target
- = modify $ \s -> s {
-        sJumpValidAcc = addToUFM_C (++)
-                                (sJumpValidAcc s)
-                                target
-                                [assocs] }
-
-
-accBlockReloadsSlot :: BlockId -> Slot -> CleanM ()
-accBlockReloadsSlot blockId slot
- = modify $ \s -> s {
-        sReloadedBy = addToUFM_C (++)
-                                (sReloadedBy s)
-                                (SSlot slot)
-                                [blockId] }
-
-
--------------------------------------------------------------------------------
--- A store location can be a stack slot or a register
-data Store
-        = SSlot Int
-        | SReg  Reg
-
-
--- | Check if this is a reg store.
-isStoreReg :: Store -> Bool
-isStoreReg ss
- = case ss of
-        SSlot _ -> False
-        SReg  _ -> True
-
-
--- Spill cleaning is only done once all virtuals have been allocated to realRegs
-instance Uniquable Store where
-    getUnique (SReg  r)
-        | RegReal (RealRegSingle i)     <- r
-        = mkRegSingleUnique i
-
-        | RegReal (RealRegPair r1 r2)   <- r
-        = mkRegPairUnique (r1 * 65535 + r2)
-
-        | otherwise
-        = error $ "RegSpillClean.getUnique: found virtual reg during spill clean,"
-                ++ "only real regs expected."
-
-    getUnique (SSlot i) = mkRegSubUnique i    -- [SLPJ] I hope "SubUnique" is ok
-
-
-instance Outputable Store where
-        ppr (SSlot i)   = text "slot" <> int i
-        ppr (SReg  r)   = ppr r
-
-
--------------------------------------------------------------------------------
--- Association graphs.
--- In the spill cleaner, two store locations are associated if they are known
--- to hold the same value.
---
-type Assoc a    = UniqFM (UniqSet a)
-
--- | An empty association
-emptyAssoc :: Assoc a
-emptyAssoc      = emptyUFM
-
-
--- | Add an association between these two things.
-addAssoc :: Uniquable a
-         => a -> a -> Assoc a -> Assoc a
-
-addAssoc a b m
- = let  m1      = addToUFM_C unionUniqSets m  a (unitUniqSet b)
-        m2      = addToUFM_C unionUniqSets m1 b (unitUniqSet a)
-   in   m2
-
-
--- | Delete all associations to a node.
-delAssoc :: (Uniquable a)
-         => a -> Assoc a -> Assoc a
-
-delAssoc a m
-        | Just aSet     <- lookupUFM  m a
-        , m1            <- delFromUFM m a
-        = nonDetFoldUniqSet (\x m -> delAssoc1 x a m) m1 aSet
-          -- It's OK to use nonDetFoldUFM here because deletion is commutative
-
-        | otherwise     = m
-
-
--- | Delete a single association edge (a -> b).
-delAssoc1 :: Uniquable a
-          => a -> a -> Assoc a -> Assoc a
-
-delAssoc1 a b m
-        | Just aSet     <- lookupUFM m a
-        = addToUFM m a (delOneFromUniqSet aSet b)
-
-        | otherwise     = m
-
-
--- | Check if these two things are associated.
-elemAssoc :: (Uniquable a)
-          => a -> a -> Assoc a -> Bool
-
-elemAssoc a b m
-        = elementOfUniqSet b (closeAssoc a m)
-
-
--- | Find the refl. trans. closure of the association from this point.
-closeAssoc :: (Uniquable a)
-        => a -> Assoc a -> UniqSet a
-
-closeAssoc a assoc
- =      closeAssoc' assoc emptyUniqSet (unitUniqSet a)
- where
-        closeAssoc' assoc visited toVisit
-         = case nonDetEltsUniqSet toVisit of
-             -- See Note [Unique Determinism and code generation]
-
-                -- nothing else to visit, we're done
-                []      -> visited
-
-                (x:_)
-                 -- we've already seen this node
-                 |  elementOfUniqSet x visited
-                 -> closeAssoc' assoc visited (delOneFromUniqSet toVisit x)
-
-                 -- haven't seen this node before,
-                 --     remember to visit all its neighbors
-                 |  otherwise
-                 -> let neighbors
-                         = case lookupUFM assoc x of
-                                Nothing         -> emptyUniqSet
-                                Just set        -> set
-
-                   in closeAssoc' assoc
-                        (addOneToUniqSet visited x)
-                        (unionUniqSets   toVisit neighbors)
-
--- | Intersect two associations.
-intersectAssoc :: Assoc a -> Assoc a -> Assoc a
-intersectAssoc a b
-        = intersectUFM_C (intersectUniqSets) a b
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
deleted file mode 100644
index 4870bf5269..0000000000
--- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ /dev/null
@@ -1,317 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables, GADTs, BangPatterns #-}
-module RegAlloc.Graph.SpillCost (
-        SpillCostRecord,
-        plusSpillCostRecord,
-        pprSpillCostRecord,
-
-        SpillCostInfo,
-        zeroSpillCostInfo,
-        plusSpillCostInfo,
-
-        slurpSpillCostInfo,
-        chooseSpill,
-
-        lifeMapFromSpillCostInfo
-) where
-import GhcPrelude
-
-import RegAlloc.Liveness
-import Instruction
-import RegClass
-import Reg
-
-import GraphBase
-
-import GHC.Cmm.Dataflow.Collections (mapLookup)
-import GHC.Cmm.Dataflow.Label
-import GHC.Cmm
-import UniqFM
-import UniqSet
-import Digraph          (flattenSCCs)
-import Outputable
-import GHC.Platform
-import State
-import CFG
-
-import Data.List        (nub, minimumBy)
-import Data.Maybe
-import Control.Monad (join)
-
-
--- | Records the expected cost to spill some register.
-type SpillCostRecord
- =      ( VirtualReg    -- register name
-        , Int           -- number of writes to this reg
-        , Int           -- number of reads from this reg
-        , Int)          -- number of instrs this reg was live on entry to
-
-
--- | Map of `SpillCostRecord`
-type SpillCostInfo
-        = UniqFM SpillCostRecord
-
-type SpillCostState = State (UniqFM SpillCostRecord) ()
-
--- | An empty map of spill costs.
-zeroSpillCostInfo :: SpillCostInfo
-zeroSpillCostInfo       = emptyUFM
-
-
--- | Add two spill cost infos.
-plusSpillCostInfo :: SpillCostInfo -> SpillCostInfo -> SpillCostInfo
-plusSpillCostInfo sc1 sc2
-        = plusUFM_C plusSpillCostRecord sc1 sc2
-
-
--- | Add two spill cost records.
-plusSpillCostRecord :: SpillCostRecord -> SpillCostRecord -> SpillCostRecord
-plusSpillCostRecord (r1, a1, b1, c1) (r2, a2, b2, c2)
-        | r1 == r2      = (r1, a1 + a2, b1 + b2, c1 + c2)
-        | otherwise     = error "RegSpillCost.plusRegInt: regs don't match"
-
-
--- | Slurp out information used for determining spill costs.
---
---   For each vreg, the number of times it was written to, read from,
---   and the number of instructions it was live on entry to (lifetime)
---
-slurpSpillCostInfo :: forall instr statics. (Outputable instr, Instruction instr)
-                   => Platform
-                   -> Maybe CFG
-                   -> LiveCmmDecl statics instr
-                   -> SpillCostInfo
-
-slurpSpillCostInfo platform cfg cmm
-        = execState (countCmm cmm) zeroSpillCostInfo
- where
-        countCmm CmmData{}              = return ()
-        countCmm (CmmProc info _ _ sccs)
-                = mapM_ (countBlock info freqMap)
-                $ flattenSCCs sccs
-            where
-                LiveInfo _ entries _ _ = info
-                freqMap = (fst . mkGlobalWeights (head entries)) <$> cfg
-
-        -- Lookup the regs that are live on entry to this block in
-        --      the info table from the CmmProc.
-        countBlock info freqMap (BasicBlock blockId instrs)
-                | LiveInfo _ _ blockLive _ <- info
-                , Just rsLiveEntry  <- mapLookup blockId blockLive
-                , rsLiveEntry_virt  <- takeVirtuals rsLiveEntry
-                = countLIs (ceiling $ blockFreq freqMap blockId) rsLiveEntry_virt instrs
-
-                | otherwise
-                = error "RegAlloc.SpillCost.slurpSpillCostInfo: bad block"
-
-
-        countLIs :: Int -> UniqSet VirtualReg -> [LiveInstr instr] -> SpillCostState
-        countLIs _      _      []
-                = return ()
-
-        -- Skip over comment and delta pseudo instrs.
-        countLIs scale rsLive (LiveInstr instr Nothing : lis)
-                | isMetaInstr instr
-                = countLIs scale rsLive lis
-
-                | otherwise
-                = pprPanic "RegSpillCost.slurpSpillCostInfo"
-                $ text "no liveness information on instruction " <> ppr instr
-
-        countLIs scale rsLiveEntry (LiveInstr instr (Just live) : lis)
-         = do
-                -- Increment the lifetime counts for regs live on entry to this instr.
-                mapM_ incLifetime $ nonDetEltsUniqSet rsLiveEntry
-                    -- This is non-deterministic but we do not
-                    -- currently support deterministic code-generation.
-                    -- See Note [Unique Determinism and code generation]
-
-                -- Increment counts for what regs were read/written from.
-                let (RU read written)   = regUsageOfInstr platform instr
-                mapM_ (incUses scale) $ catMaybes $ map takeVirtualReg $ nub read
-                mapM_ (incDefs scale) $ catMaybes $ map takeVirtualReg $ nub written
-
-                -- Compute liveness for entry to next instruction.
-                let liveDieRead_virt    = takeVirtuals (liveDieRead  live)
-                let liveDieWrite_virt   = takeVirtuals (liveDieWrite live)
-                let liveBorn_virt       = takeVirtuals (liveBorn     live)
-
-                let rsLiveAcross
-                        = rsLiveEntry `minusUniqSet` liveDieRead_virt
-
-                let rsLiveNext
-                        = (rsLiveAcross `unionUniqSets` liveBorn_virt)
-                                        `minusUniqSet`  liveDieWrite_virt
-
-                countLIs scale rsLiveNext lis
-
-        incDefs     count reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, count, 0, 0)
-        incUses     count reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, count, 0)
-        incLifetime       reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, 0, 1)
-
-        blockFreq :: Maybe (LabelMap Double) -> Label -> Double
-        blockFreq freqs bid
-          | Just freq <- join (mapLookup bid <$> freqs)
-          = max 1.0 (10000 * freq)
-          | otherwise
-          = 1.0 -- Only if no cfg given
-
--- | Take all the virtual registers from this set.
-takeVirtuals :: UniqSet Reg -> UniqSet VirtualReg
-takeVirtuals set = mkUniqSet
-  [ vr | RegVirtual vr <- nonDetEltsUniqSet set ]
-  -- See Note [Unique Determinism and code generation]
-
-
--- | Choose a node to spill from this graph
-chooseSpill
-        :: SpillCostInfo
-        -> Graph VirtualReg RegClass RealReg
-        -> VirtualReg
-
-chooseSpill info graph
- = let  cost    = spillCost_length info graph
-        node    = minimumBy (\n1 n2 -> compare (cost $ nodeId n1) (cost $ nodeId n2))
-                $ nonDetEltsUFM $ graphMap graph
-                -- See Note [Unique Determinism and code generation]
-
-   in   nodeId node
-
-
--------------------------------------------------------------------------------
--- | Chaitins spill cost function is:
---
---   cost =     sum         loadCost * freq (u)  +    sum        storeCost * freq (d)
---          u <- uses (v)                         d <- defs (v)
---
---   There are no loops in our code at the moment, so we can set the freq's to 1.
---
---  If we don't have live range splitting then Chaitins function performs badly
---  if we have lots of nested live ranges and very few registers.
---
---               v1 v2 v3
---      def v1   .
---      use v1   .
---      def v2   .  .
---      def v3   .  .  .
---      use v1   .  .  .
---      use v3   .  .  .
---      use v2   .  .
---      use v1   .
---
---           defs uses degree   cost
---      v1:  1     3     3      1.5
---      v2:  1     2     3      1.0
---      v3:  1     1     3      0.666
---
---   v3 has the lowest cost, but if we only have 2 hardregs and we insert
---   spill code for v3 then this isn't going to improve the colorability of
---   the graph.
---
---  When compiling SHA1, which as very long basic blocks and some vregs
---  with very long live ranges the allocator seems to try and spill from
---  the inside out and eventually run out of stack slots.
---
---  Without live range splitting, its's better to spill from the outside
---  in so set the cost of very long live ranges to zero
---
-
--- spillCost_chaitin
---         :: SpillCostInfo
---         -> Graph VirtualReg RegClass RealReg
---         -> VirtualReg
---         -> Float
-
--- spillCost_chaitin info graph reg
---         -- Spilling a live range that only lives for 1 instruction
---         -- isn't going to help us at all - and we definitely want to avoid
---         -- trying to re-spill previously inserted spill code.
---         | lifetime <= 1         = 1/0
-
---         -- It's unlikely that we'll find a reg for a live range this long
---         -- better to spill it straight up and not risk trying to keep it around
---         -- and have to go through the build/color cycle again.
-
---         -- To facility this we scale down the spill cost of long ranges.
---         -- This makes sure long ranges are still spilled first.
---         -- But this way spill cost remains relevant for long live
---         -- ranges.
---         | lifetime >= 128
---         = (spillCost / conflicts) / 10.0
-
-
---         -- Otherwise revert to chaitin's regular cost function.
---         | otherwise = (spillCost / conflicts)
---         where
---             !spillCost = fromIntegral (uses + defs) :: Float
---             conflicts = fromIntegral (nodeDegree classOfVirtualReg graph reg)
---             (_, defs, uses, lifetime)
---                 = fromMaybe (reg, 0, 0, 0) $ lookupUFM info reg
-
-
--- Just spill the longest live range.
-spillCost_length
-        :: SpillCostInfo
-        -> Graph VirtualReg RegClass RealReg
-        -> VirtualReg
-        -> Float
-
-spillCost_length info _ reg
-        | lifetime <= 1         = 1/0
-        | otherwise             = 1 / fromIntegral lifetime
-        where (_, _, _, lifetime)
-                = fromMaybe (reg, 0, 0, 0)
-                $ lookupUFM info reg
-
-
--- | Extract a map of register lifetimes from a `SpillCostInfo`.
-lifeMapFromSpillCostInfo :: SpillCostInfo -> UniqFM (VirtualReg, Int)
-lifeMapFromSpillCostInfo info
-        = listToUFM
-        $ map (\(r, _, _, life) -> (r, (r, life)))
-        $ nonDetEltsUFM info
-        -- See Note [Unique Determinism and code generation]
-
-
--- | Determine the degree (number of neighbors) of this node which
---   have the same class.
-nodeDegree
-        :: (VirtualReg -> RegClass)
-        -> Graph VirtualReg RegClass RealReg
-        -> VirtualReg
-        -> Int
-
-nodeDegree classOfVirtualReg graph reg
-        | Just node     <- lookupUFM (graphMap graph) reg
-
-        , virtConflicts
-           <- length
-           $ filter (\r -> classOfVirtualReg r == classOfVirtualReg reg)
-           $ nonDetEltsUniqSet
-           -- See Note [Unique Determinism and code generation]
-           $ nodeConflicts node
-
-        = virtConflicts + sizeUniqSet (nodeExclusions node)
-
-        | otherwise
-        = 0
-
-
--- | Show a spill cost record, including the degree from the graph
---   and final calculated spill cost.
-pprSpillCostRecord
-        :: (VirtualReg -> RegClass)
-        -> (Reg -> SDoc)
-        -> Graph VirtualReg RegClass RealReg
-        -> SpillCostRecord
-        -> SDoc
-
-pprSpillCostRecord regClass pprReg graph (reg, uses, defs, life)
-        =  hsep
-        [ pprReg (RegVirtual reg)
-        , ppr uses
-        , ppr defs
-        , ppr life
-        , ppr $ nodeDegree regClass graph reg
-        , text $ show $ (fromIntegral (uses + defs)
-                       / fromIntegral (nodeDegree regClass graph reg) :: Float) ]
-
diff --git a/compiler/nativeGen/RegAlloc/Graph/Stats.hs b/compiler/nativeGen/RegAlloc/Graph/Stats.hs
deleted file mode 100644
index 2159548437..0000000000
--- a/compiler/nativeGen/RegAlloc/Graph/Stats.hs
+++ /dev/null
@@ -1,346 +0,0 @@
-{-# LANGUAGE BangPatterns, CPP #-}
-
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
-
--- | Carries interesting info for debugging / profiling of the
---   graph coloring register allocator.
-module RegAlloc.Graph.Stats (
-        RegAllocStats (..),
-
-        pprStats,
-        pprStatsSpills,
-        pprStatsLifetimes,
-        pprStatsConflict,
-        pprStatsLifeConflict,
-
-        countSRMs, addSRM
-) where
-
-import GhcPrelude
-
-import qualified GraphColor as Color
-import RegAlloc.Liveness
-import RegAlloc.Graph.Spill
-import RegAlloc.Graph.SpillCost
-import RegAlloc.Graph.TrivColorable
-import Instruction
-import RegClass
-import Reg
-import TargetReg
-
-import Outputable
-import UniqFM
-import UniqSet
-import State
-
--- | Holds interesting statistics from the register allocator.
-data RegAllocStats statics instr
-
-        -- Information about the initial conflict graph.
-        = RegAllocStatsStart
-        { -- | Initial code, with liveness.
-          raLiveCmm     :: [LiveCmmDecl statics instr]
-
-          -- | The initial, uncolored graph.
-        , raGraph       :: Color.Graph VirtualReg RegClass RealReg
-
-          -- | Information to help choose which regs to spill.
-        , raSpillCosts  :: SpillCostInfo }
-
-
-        -- Information about an intermediate graph.
-        -- This is one that we couldn't color, so had to insert spill code
-        -- instruction stream.
-        | RegAllocStatsSpill
-        { -- | Code we tried to allocate registers for.
-          raCode        :: [LiveCmmDecl statics instr]
-
-          -- | Partially colored graph.
-        , raGraph       :: Color.Graph VirtualReg RegClass RealReg
-
-          -- | The regs that were coalesced.
-        , raCoalesced   :: UniqFM VirtualReg
-
-          -- | Spiller stats.
-        , raSpillStats  :: SpillStats
-
-          -- | Number of instructions each reg lives for.
-        , raSpillCosts  :: SpillCostInfo
-
-          -- | Code with spill instructions added.
-        , raSpilled     :: [LiveCmmDecl statics instr] }
-
-
-        -- a successful coloring
-        | RegAllocStatsColored
-        { -- | Code we tried to allocate registers for.
-          raCode          :: [LiveCmmDecl statics instr]
-
-          -- | Uncolored graph.
-        , raGraph         :: Color.Graph VirtualReg RegClass RealReg
-
-          -- | Coalesced and colored graph.
-        , raGraphColored  :: Color.Graph VirtualReg RegClass RealReg
-
-          -- | Regs that were coalesced.
-        , raCoalesced     :: UniqFM VirtualReg
-
-          -- | Code with coalescings applied.
-        , raCodeCoalesced :: [LiveCmmDecl statics instr]
-
-          -- | Code with vregs replaced by hregs.
-        , raPatched       :: [LiveCmmDecl statics instr]
-
-          -- | Code with unneeded spill\/reloads cleaned out.
-        , raSpillClean    :: [LiveCmmDecl statics instr]
-
-          -- | Final code.
-        , raFinal         :: [NatCmmDecl statics instr]
-
-          -- | Spill\/reload\/reg-reg moves present in this code.
-        , raSRMs          :: (Int, Int, Int) }
-
-
-instance (Outputable statics, Outputable instr)
-       => Outputable (RegAllocStats statics instr) where
-
- ppr (s@RegAllocStatsStart{}) = sdocWithPlatform $ \platform ->
-           text "#  Start"
-        $$ text "#  Native code with liveness information."
-        $$ ppr (raLiveCmm s)
-        $$ text ""
-        $$ text "#  Initial register conflict graph."
-        $$ Color.dotGraph
-                (targetRegDotColor platform)
-                (trivColorable platform
-                        (targetVirtualRegSqueeze platform)
-                        (targetRealRegSqueeze platform))
-                (raGraph s)
-
-
- ppr (s@RegAllocStatsSpill{}) =
-           text "#  Spill"
-
-        $$ text "#  Code with liveness information."
-        $$ ppr (raCode s)
-        $$ text ""
-
-        $$ (if (not $ isNullUFM $ raCoalesced s)
-                then    text "#  Registers coalesced."
-                        $$ pprUFMWithKeys (raCoalesced s) (vcat . map ppr)
-                        $$ text ""
-                else empty)
-
-        $$ text "#  Spills inserted."
-        $$ ppr (raSpillStats s)
-        $$ text ""
-
-        $$ text "#  Code with spills inserted."
-        $$ ppr (raSpilled s)
-
-
- ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
-    = sdocWithPlatform $ \platform ->
-           text "#  Colored"
-
-        $$ text "#  Code with liveness information."
-        $$ ppr (raCode s)
-        $$ text ""
-
-        $$ text "#  Register conflict graph (colored)."
-        $$ Color.dotGraph
-                (targetRegDotColor platform)
-                (trivColorable platform
-                        (targetVirtualRegSqueeze platform)
-                        (targetRealRegSqueeze platform))
-                (raGraphColored s)
-        $$ text ""
-
-        $$ (if (not $ isNullUFM $ raCoalesced s)
-                then    text "#  Registers coalesced."
-                        $$ pprUFMWithKeys (raCoalesced s) (vcat . map ppr)
-                        $$ text ""
-                else empty)
-
-        $$ text "#  Native code after coalescings applied."
-        $$ ppr (raCodeCoalesced s)
-        $$ text ""
-
-        $$ text "#  Native code after register allocation."
-        $$ ppr (raPatched s)
-        $$ text ""
-
-        $$ text "#  Clean out unneeded spill/reloads."
-        $$ ppr (raSpillClean s)
-        $$ text ""
-
-        $$ text "#  Final code, after rewriting spill/rewrite pseudo instrs."
-        $$ ppr (raFinal s)
-        $$ text ""
-        $$  text "#  Score:"
-        $$ (text "#          spills  inserted: " <> int spills)
-        $$ (text "#          reloads inserted: " <> int reloads)
-        $$ (text "#   reg-reg moves remaining: " <> int moves)
-        $$ text ""
-
-
--- | Do all the different analysis on this list of RegAllocStats
-pprStats
-        :: [RegAllocStats statics instr]
-        -> Color.Graph VirtualReg RegClass RealReg
-        -> SDoc
-
-pprStats stats graph
- = let  outSpills       = pprStatsSpills    stats
-        outLife         = pprStatsLifetimes stats
-        outConflict     = pprStatsConflict  stats
-        outScatter      = pprStatsLifeConflict stats graph
-
-  in    vcat [outSpills, outLife, outConflict, outScatter]
-
-
--- | Dump a table of how many spill loads \/ stores were inserted for each vreg.
-pprStatsSpills
-        :: [RegAllocStats statics instr] -> SDoc
-
-pprStatsSpills stats
- = let
-        finals  = [ s   | s@RegAllocStatsColored{} <- stats]
-
-        -- sum up how many stores\/loads\/reg-reg-moves were left in the code
-        total   = foldl' addSRM (0, 0, 0)
-                $ map raSRMs finals
-
-    in  (  text "-- spills-added-total"
-        $$ text "--    (stores, loads, reg_reg_moves_remaining)"
-        $$ ppr total
-        $$ text "")
-
-
--- | Dump a table of how long vregs tend to live for in the initial code.
-pprStatsLifetimes
-        :: [RegAllocStats statics instr] -> SDoc
-
-pprStatsLifetimes stats
- = let  info            = foldl' plusSpillCostInfo zeroSpillCostInfo
-                                [ raSpillCosts s
-                                        | s@RegAllocStatsStart{} <- stats ]
-
-        lifeBins        = binLifetimeCount $ lifeMapFromSpillCostInfo info
-
-   in   (  text "-- vreg-population-lifetimes"
-        $$ text "--   (instruction_count, number_of_vregs_that_lived_that_long)"
-        $$ pprUFM lifeBins (vcat . map ppr)
-        $$ text "\n")
-
-
-binLifetimeCount :: UniqFM (VirtualReg, Int) -> UniqFM (Int, Int)
-binLifetimeCount fm
- = let  lifes   = map (\l -> (l, (l, 1)))
-                $ map snd
-                $ nonDetEltsUFM fm
-                -- See Note [Unique Determinism and code generation]
-
-   in   addListToUFM_C
-                (\(l1, c1) (_, c2) -> (l1, c1 + c2))
-                emptyUFM
-                lifes
-
-
--- | Dump a table of how many conflicts vregs tend to have in the initial code.
-pprStatsConflict
-        :: [RegAllocStats statics instr] -> SDoc
-
-pprStatsConflict stats
- = let  confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
-                        emptyUFM
-                $ map Color.slurpNodeConflictCount
-                        [ raGraph s | s@RegAllocStatsStart{} <- stats ]
-
-   in   (  text "-- vreg-conflicts"
-        $$ text "--   (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
-        $$ pprUFM confMap (vcat . map ppr)
-        $$ text "\n")
-
-
--- | For every vreg, dump how many conflicts it has, and its lifetime.
---      Good for making a scatter plot.
-pprStatsLifeConflict
-        :: [RegAllocStats statics instr]
-        -> Color.Graph VirtualReg RegClass RealReg -- ^ global register conflict graph
-        -> SDoc
-
-pprStatsLifeConflict stats graph
- = let  lifeMap = lifeMapFromSpillCostInfo
-                $ foldl' plusSpillCostInfo zeroSpillCostInfo
-                $ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ]
-
-        scatter = map   (\r ->  let lifetime  = case lookupUFM lifeMap r of
-                                                      Just (_, l) -> l
-                                                      Nothing     -> 0
-                                    Just node = Color.lookupNode graph r
-                                in parens $ hcat $ punctuate (text ", ")
-                                        [ doubleQuotes $ ppr $ Color.nodeId node
-                                        , ppr $ sizeUniqSet (Color.nodeConflicts node)
-                                        , ppr $ lifetime ])
-                $ map Color.nodeId
-                $ nonDetEltsUFM
-                -- See Note [Unique Determinism and code generation]
-                $ Color.graphMap graph
-
-   in   (  text "-- vreg-conflict-lifetime"
-        $$ text "--   (vreg, vreg_conflicts, vreg_lifetime)"
-        $$ (vcat scatter)
-        $$ text "\n")
-
-
--- | Count spill/reload/reg-reg moves.
---      Lets us see how well the register allocator has done.
-countSRMs
-        :: Instruction instr
-        => LiveCmmDecl statics instr -> (Int, Int, Int)
-
-countSRMs cmm
-        = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)
-
-
-countSRM_block
-        :: Instruction instr
-        => GenBasicBlock (LiveInstr instr)
-        -> State (Int, Int, Int) (GenBasicBlock (LiveInstr instr))
-
-countSRM_block (BasicBlock i instrs)
- = do   instrs' <- mapM countSRM_instr instrs
-        return  $ BasicBlock i instrs'
-
-
-countSRM_instr
-        :: Instruction instr
-        => LiveInstr instr -> State (Int, Int, Int) (LiveInstr instr)
-
-countSRM_instr li
-        | LiveInstr SPILL{} _    <- li
-        = do    modify  $ \(s, r, m)    -> (s + 1, r, m)
-                return li
-
-        | LiveInstr RELOAD{} _  <- li
-        = do    modify  $ \(s, r, m)    -> (s, r + 1, m)
-                return li
-
-        | LiveInstr instr _     <- li
-        , Just _        <- takeRegRegMoveInstr instr
-        = do    modify  $ \(s, r, m)    -> (s, r, m + 1)
-                return li
-
-        | otherwise
-        =       return li
-
-
--- sigh..
-addSRM :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int)
-addSRM (s1, r1, m1) (s2, r2, m2)
- = let  !s = s1 + s2
-        !r = r1 + r2
-        !m = m1 + m2
-   in   (s, r, m)
-
diff --git a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
deleted file mode 100644
index cc2ad7d594..0000000000
--- a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
+++ /dev/null
@@ -1,274 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-module RegAlloc.Graph.TrivColorable (
-        trivColorable,
-)
-
-where
-
-#include "HsVersions.h"
-
-import GhcPrelude
-
-import RegClass
-import Reg
-
-import GraphBase
-
-import UniqSet
-import GHC.Platform
-import Panic
-
--- trivColorable ---------------------------------------------------------------
-
--- trivColorable function for the graph coloring allocator
---
---      This gets hammered by scanGraph during register allocation,
---      so needs to be fairly efficient.
---
---      NOTE:   This only works for architectures with just RcInteger and RcDouble
---              (which are disjoint) ie. x86, x86_64 and ppc
---
---      The number of allocatable regs is hard coded in here so we can do
---              a fast comparison in trivColorable.
---
---      It's ok if these numbers are _less_ than the actual number of free
---              regs, but they can't be more or the register conflict
---              graph won't color.
---
---      If the graph doesn't color then the allocator will panic, but it won't
---              generate bad object code or anything nasty like that.
---
---      There is an allocatableRegsInClass :: RegClass -> Int, but doing
---      the unboxing is too slow for us here.
---      TODO: Is that still true? Could we use allocatableRegsInClass
---      without losing performance now?
---
---      Look at includes/stg/MachRegs.h to get the numbers.
---
-
-
--- Disjoint registers ----------------------------------------------------------
---
---      The definition has been unfolded into individual cases for speed.
---      Each architecture has a different register setup, so we use a
---      different regSqueeze function for each.
---
-accSqueeze
-        :: Int
-        -> Int
-        -> (reg -> Int)
-        -> UniqSet reg
-        -> Int
-
-accSqueeze count maxCount squeeze us = acc count (nonDetEltsUniqSet us)
-  -- See Note [Unique Determinism and code generation]
-  where acc count [] = count
-        acc count _ | count >= maxCount = count
-        acc count (r:rs) = acc (count + squeeze r) rs
-
-{- Note [accSqueeze]
-~~~~~~~~~~~~~~~~~~~~
-BL 2007/09
-Doing a nice fold over the UniqSet makes trivColorable use
-32% of total compile time and 42% of total alloc when compiling SHA1.hs from darcs.
-Therefore the UniqFM is made non-abstract and we use custom fold.
-
-MS 2010/04
-When converting UniqFM to use Data.IntMap, the fold cannot use UniqFM internal
-representation any more. But it is imperative that the accSqueeze stops
-the folding if the count gets greater or equal to maxCount. We thus convert
-UniqFM to a (lazy) list, do the fold and stops if necessary, which was
-the most efficient variant tried. Benchmark compiling 10-times SHA1.hs follows.
-(original = previous implementation, folding = fold of the whole UFM,
- lazyFold = the current implementation,
- hackFold = using internal representation of Data.IntMap)
-
-                                 original  folding   hackFold  lazyFold
- -O -fasm (used everywhere)      31.509s   30.387s   30.791s   30.603s
-                                 100.00%   96.44%    97.72%    97.12%
- -fregs-graph                    67.938s   74.875s   62.673s   64.679s
-                                 100.00%   110.21%   92.25%    95.20%
- -fregs-iterative                89.761s   143.913s  81.075s   86.912s
-                                 100.00%   160.33%   90.32%    96.83%
- -fnew-codegen                   38.225s   37.142s   37.551s   37.119s
-                                 100.00%   97.17%    98.24%    97.11%
- -fnew-codegen -fregs-graph      91.786s   91.51s    87.368s   86.88s
-                                 100.00%   99.70%    95.19%    94.65%
- -fnew-codegen -fregs-iterative  206.72s   343.632s  194.694s  208.677s
-                                 100.00%   166.23%   94.18%    100.95%
--}
-
-trivColorable
-        :: Platform
-        -> (RegClass -> VirtualReg -> Int)
-        -> (RegClass -> RealReg    -> Int)
-        -> Triv VirtualReg RegClass RealReg
-
-trivColorable platform virtualRegSqueeze realRegSqueeze RcInteger conflicts exclusions
-        | let cALLOCATABLE_REGS_INTEGER
-                  =        (case platformArch platform of
-                            ArchX86       -> 3
-                            ArchX86_64    -> 5
-                            ArchPPC       -> 16
-                            ArchSPARC     -> 14
-                            ArchSPARC64   -> panic "trivColorable ArchSPARC64"
-                            ArchPPC_64 _  -> 15
-                            ArchARM _ _ _ -> panic "trivColorable ArchARM"
-                            ArchARM64     -> panic "trivColorable ArchARM64"
-                            ArchAlpha     -> panic "trivColorable ArchAlpha"
-                            ArchMipseb    -> panic "trivColorable ArchMipseb"
-                            ArchMipsel    -> panic "trivColorable ArchMipsel"
-                            ArchS390X     -> panic "trivColorable ArchS390X"
-                            ArchJavaScript-> panic "trivColorable ArchJavaScript"
-                            ArchUnknown   -> panic "trivColorable ArchUnknown")
-        , count2        <- accSqueeze 0 cALLOCATABLE_REGS_INTEGER
-                                (virtualRegSqueeze RcInteger)
-                                conflicts
-
-        , count3        <- accSqueeze  count2    cALLOCATABLE_REGS_INTEGER
-                                (realRegSqueeze   RcInteger)
-                                exclusions
-
-        = count3 < cALLOCATABLE_REGS_INTEGER
-
-trivColorable platform virtualRegSqueeze realRegSqueeze RcFloat conflicts exclusions
-        | let cALLOCATABLE_REGS_FLOAT
-                  =        (case platformArch platform of
-                    -- On x86_64 and x86, Float and RcDouble
-                    -- use the same registers,
-                    -- so we only use RcDouble to represent the
-                    -- register allocation problem on those types.
-                            ArchX86       -> 0
-                            ArchX86_64    -> 0
-                            ArchPPC       -> 0
-                            ArchSPARC     -> 22
-                            ArchSPARC64   -> panic "trivColorable ArchSPARC64"
-                            ArchPPC_64 _  -> 0
-                            ArchARM _ _ _ -> panic "trivColorable ArchARM"
-                            ArchARM64     -> panic "trivColorable ArchARM64"
-                            ArchAlpha     -> panic "trivColorable ArchAlpha"
-                            ArchMipseb    -> panic "trivColorable ArchMipseb"
-                            ArchMipsel    -> panic "trivColorable ArchMipsel"
-                            ArchS390X     -> panic "trivColorable ArchS390X"
-                            ArchJavaScript-> panic "trivColorable ArchJavaScript"
-                            ArchUnknown   -> panic "trivColorable ArchUnknown")
-        , count2        <- accSqueeze 0 cALLOCATABLE_REGS_FLOAT
-                                (virtualRegSqueeze RcFloat)
-                                conflicts
-
-        , count3        <- accSqueeze  count2    cALLOCATABLE_REGS_FLOAT
-                                (realRegSqueeze   RcFloat)
-                                exclusions
-
-        = count3 < cALLOCATABLE_REGS_FLOAT
-
-trivColorable platform virtualRegSqueeze realRegSqueeze RcDouble conflicts exclusions
-        | let cALLOCATABLE_REGS_DOUBLE
-                  =        (case platformArch platform of
-                            ArchX86       -> 8
-                            -- in x86 32bit mode sse2 there are only
-                            -- 8 XMM registers xmm0 ... xmm7
-                            ArchX86_64    -> 10
-                            -- in x86_64 there are 16 XMM registers
-                            -- xmm0 .. xmm15, here 10 is a
-                            -- "dont need to solve conflicts" count that
-                            -- was chosen at some point in the past.
-                            ArchPPC       -> 26
-                            ArchSPARC     -> 11
-                            ArchSPARC64   -> panic "trivColorable ArchSPARC64"
-                            ArchPPC_64 _  -> 20
-                            ArchARM _ _ _ -> panic "trivColorable ArchARM"
-                            ArchARM64     -> panic "trivColorable ArchARM64"
-                            ArchAlpha     -> panic "trivColorable ArchAlpha"
-                            ArchMipseb    -> panic "trivColorable ArchMipseb"
-                            ArchMipsel    -> panic "trivColorable ArchMipsel"
-                            ArchS390X     -> panic "trivColorable ArchS390X"
-                            ArchJavaScript-> panic "trivColorable ArchJavaScript"
-                            ArchUnknown   -> panic "trivColorable ArchUnknown")
-        , count2        <- accSqueeze 0 cALLOCATABLE_REGS_DOUBLE
-                                (virtualRegSqueeze RcDouble)
-                                conflicts
-
-        , count3        <- accSqueeze  count2    cALLOCATABLE_REGS_DOUBLE
-                                (realRegSqueeze   RcDouble)
-                                exclusions
-
-        = count3 < cALLOCATABLE_REGS_DOUBLE
-
-
-
-
--- Specification Code ----------------------------------------------------------
---
---      The trivColorable function for each particular architecture should
---      implement the following function, but faster.
---
-
-{-
-trivColorable :: RegClass -> UniqSet Reg -> UniqSet Reg -> Bool
-trivColorable classN conflicts exclusions
- = let
-
-        acc :: Reg -> (Int, Int) -> (Int, Int)
-        acc r (cd, cf)
-         = case regClass r of
-                RcInteger       -> (cd+1, cf)
-                RcFloat         -> (cd,   cf+1)
-                _               -> panic "Regs.trivColorable: reg class not handled"
-
-        tmp                     = nonDetFoldUFM acc (0, 0) conflicts
-        (countInt,  countFloat) = nonDetFoldUFM acc tmp    exclusions
-
-        squeese         = worst countInt   classN RcInteger
-                        + worst countFloat classN RcFloat
-
-   in   squeese < allocatableRegsInClass classN
-
--- | Worst case displacement
---      node N of classN has n neighbors of class C.
---
---      We currently only have RcInteger and RcDouble, which don't conflict at all.
---      This is a bit boring compared to what's in RegArchX86.
---
-worst :: Int -> RegClass -> RegClass -> Int
-worst n classN classC
- = case classN of
-        RcInteger
-         -> case classC of
-                RcInteger       -> min n (allocatableRegsInClass RcInteger)
-                RcFloat         -> 0
-
-        RcDouble
-         -> case classC of
-                RcFloat         -> min n (allocatableRegsInClass RcFloat)
-                RcInteger       -> 0
-
--- allocatableRegs is allMachRegNos with the fixed-use regs removed.
--- i.e., these are the regs for which we are prepared to allow the
--- register allocator to attempt to map VRegs to.
-allocatableRegs :: [RegNo]
-allocatableRegs
-   = let isFree i = freeReg i
-     in  filter isFree allMachRegNos
-
-
--- | The number of regs in each class.
---      We go via top level CAFs to ensure that we're not recomputing
---      the length of these lists each time the fn is called.
-allocatableRegsInClass :: RegClass -> Int
-allocatableRegsInClass cls
- = case cls of
-        RcInteger       -> allocatableRegsInteger
-        RcFloat         -> allocatableRegsDouble
-
-allocatableRegsInteger :: Int
-allocatableRegsInteger
-        = length $ filter (\r -> regClass r == RcInteger)
-                 $ map RealReg allocatableRegs
-
-allocatableRegsFloat :: Int
-allocatableRegsFloat
-        = length $ filter (\r -> regClass r == RcFloat
-                 $ map RealReg allocatableRegs
--}