[commit: ghc] master: Performance improvements linear regAlloc (#7258) (df63668)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/df636682f3b8299268d189bfaf6de1d672c19a73/ghc

>---------------------------------------------------------------

commit df636682f3b8299268d189bfaf6de1d672c19a73
Author: Tobias Dammers <tdammers at gmail.com>
Date:   Wed Oct 25 15:50:32 2017 -0400

    Performance improvements linear regAlloc (#7258)
    
    When allocating and potentially spilling registers, we need to check
    the desired allocations against current allocations to decide where we
    can spill to, cq. which allocations we can toss and if so, how.
    Previously, this was done by walking the Cartesian product of the
    current allocations (`assig`) and the allocations to keep (`keep`),
    which has quadratic complexity. This patch introduces two improvements:
    
    1. pre-filter the `assig` list, because we are only interested in two
    types of allocations (in register, and in register+memory), which will
    only make up a small and constant portion of the list; and
    2. use set / map operations instead of lists, which reduces algorithmic
    complexity.
    
    Reviewers: austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D4109


>---------------------------------------------------------------

df636682f3b8299268d189bfaf6de1d672c19a73
 compiler/nativeGen/RegAlloc/Linear/Main.hs | 24 +++++++++++++-----------
 1 file changed, 13 insertions(+), 11 deletions(-)

diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 171ce88..6171d8d 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -809,27 +809,29 @@ allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
 
           -- case (3): we need to push something out to free up a register
          [] ->
-           do   let keep' = map getUnique keep
+           do   let inRegOrBoth (InReg _) = True
+                    inRegOrBoth (InBoth _ _) = True
+                    inRegOrBoth _ = False
+                let candidates' =
+                      flip delListFromUFM keep $
+                      filterUFM inRegOrBoth $
+                      assig
+                      -- This is non-deterministic but we do not
+                      -- currently support deterministic code-generation.
+                      -- See Note [Unique Determinism and code generation]
+                let candidates = nonDetUFMToList candidates'
 
                 -- the vregs we could kick out that are already in a slot
                 let candidates_inBoth
                         = [ (temp, reg, mem)
-                          | (temp, InBoth reg mem) <- nonDetUFMToList assig
-                          -- This is non-deterministic but we do not
-                          -- currently support deterministic code-generation.
-                          -- See Note [Unique Determinism and code generation]
-                          , temp `notElem` keep'
+                          | (temp, InBoth reg mem) <- candidates
                           , targetClassOfRealReg platform reg == classOfVirtualReg r ]
 
                 -- the vregs we could kick out that are only in a reg
                 --      this would require writing the reg to a new slot before using it.
                 let candidates_inReg
                         = [ (temp, reg)
-                          | (temp, InReg reg) <- nonDetUFMToList assig
-                          -- This is non-deterministic but we do not
-                          -- currently support deterministic code-generation.
-                          -- See Note [Unique Determinism and code generation]
-                          , temp `notElem` keep'
+                          | (temp, InReg reg) <- candidates
                           , targetClassOfRealReg platform reg == classOfVirtualReg r ]
 
                 let result