Improve code generated when real registers are clobbered

There was a long-standing ToDo here that I just did: if a real
register is clobbered by the current instruction, then we should move
it to another free register rather than spilling it to memory.  This
case crops up more often now that the register allocator can allocate
into the fixed Rn registers.

1 files changed, 59 insertions, 32 deletions

diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 44fc8ef896..1b6810ed07 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -23,16 +23,7 @@ The algorithm is roughly:
             we fill in its entry in this table with the current mapping.
 
      For each instruction:
-        (a) For each real register clobbered by this instruction:
-            If a temporary resides in it,
-                If the temporary is live after this instruction,
-                    Move the temporary to another (non-clobbered & free) reg,
-                    or spill it to memory.  Mark the temporary as residing
-                    in both memory and a register if it was spilled (it might
-                    need to be read by this instruction).
-            (ToDo: this is wrong for jump instructions?)
-
-        (b) For each temporary *read* by the instruction:
+        (a) For each temporary *read* by the instruction:
             If the temporary does not have a real register allocation:
                 - Allocate a real register from the free list.  If
                   the list is empty:
@@ -45,6 +36,26 @@ The algorithm is roughly:
             (optimisation: if we can see that a real register is going to
             be used soon, then don't use it for allocation).
 
+        (b) For each real register clobbered by this instruction:
+            If a temporary resides in it,
+                If the temporary is live after this instruction,
+                    Move the temporary to another (non-clobbered & free) reg,
+                    or spill it to memory.  Mark the temporary as residing
+                    in both memory and a register if it was spilled (it might
+                    need to be read by this instruction).
+
+            (ToDo: this is wrong for jump instructions?)
+
+            We do this after step (a), because if we start with
+               movq v1, %rsi
+            which is an instruction that clobbers %rsi, if v1 currently resides
+            in %rsi we want to get
+               movq %rsi, %freereg
+               movq %rsi, %rsi     -- will disappear
+            instead of
+               movq %rsi, %freereg
+               movq %freereg, %rsi
+
         (c) Update the current assignment
 
         (d) If the instruction is a branch:
@@ -446,9 +457,6 @@ genRaInsn platform block_live new_instrs block_id instr r_dying w_dying =
     -- so using nub isn't a problem).
     let virt_read       = nub [ vr      | (RegVirtual vr) <- read ]
 
-    -- (a) save any temporaries which will be clobbered by this instruction
-    clobber_saves       <- saveClobberedTemps platform real_written r_dying
-
     -- debugging
 {-    freeregs <- getFreeRegsR
     assig    <- getAssigR
@@ -463,10 +471,13 @@ genRaInsn platform block_live new_instrs block_id instr r_dying w_dying =
         $ do
 -}
 
-    -- (b), (c) allocate real regs for all regs read by this instruction.
+    -- (a), (b) allocate real regs for all regs read by this instruction.
     (r_spills, r_allocd) <-
         allocateRegsAndSpill platform True{-reading-} virt_read [] [] virt_read
 
+    -- (a) save any temporaries which will be clobbered by this instruction
+    clobber_saves <- saveClobberedTemps platform real_written r_dying
+
     -- (d) Update block map for new destinations
     -- NB. do this before removing dead regs from the assignment, because
     -- these dead regs might in fact be live in the jump targets (they're
@@ -559,13 +570,9 @@ releaseRegs regs = do
 --      for allocateRegs on the temps *written*,
 --        - clobbered regs are not allocatable.
 --
---      TODO:   instead of spilling, try to copy clobbered
---              temps to another register if possible.
---
-
 
 saveClobberedTemps
-        :: (Outputable instr, Instruction instr)
+        :: (Outputable instr, Instruction instr, FR freeRegs)
         => Platform
         -> [RealReg]            -- real registers clobbered by this instruction
         -> [Reg]                -- registers which are no longer live after this insn
@@ -589,19 +596,39 @@ saveClobberedTemps platform clobbered dying
         return instrs
 
    where
-        clobber assig instrs []
-                = return (instrs, assig)
-
-        clobber assig instrs ((temp, reg) : rest)
-         = do
-                (spill, slot)   <- spillR platform (RegReal reg) temp
-
-                -- record why this reg was spilled for profiling
-                recordSpill (SpillClobber temp)
-
-                let new_assign  = addToUFM assig temp (InBoth reg slot)
-
-                clobber new_assign (spill : instrs) rest
+     clobber assig instrs []
+            = return (instrs, assig)
+
+     clobber assig instrs ((temp, reg) : rest)
+       = do
+            freeRegs <- getFreeRegsR
+            let regclass = targetClassOfRealReg platform reg
+                freeRegs_thisClass = frGetFreeRegs regclass freeRegs
+
+            case filter (`notElem` clobbered) freeRegs_thisClass of
+
+              -- (1) we have a free reg of the right class that isn't
+              -- clobbered by this instruction; use it to save the
+              -- clobbered value.
+              (my_reg : _) -> do
+                  setFreeRegsR (frAllocateReg my_reg freeRegs)
+
+                  let new_assign = addToUFM assig temp (InReg my_reg)
+                  let instr = mkRegRegMoveInstr platform
+                                  (RegReal reg) (RegReal my_reg)
+
+                  clobber new_assign (instr : instrs) rest
+
+              -- (2) no free registers: spill the value
+              [] -> do
+                  (spill, slot)   <- spillR platform (RegReal reg) temp
+     
+                  -- record why this reg was spilled for profiling
+                  recordSpill (SpillClobber temp)
+     
+                  let new_assign  = addToUFM assig temp (InBoth reg slot)
+     
+                  clobber new_assign (spill : instrs) rest