[project @ 2005-01-28 12:55:17 by simonmar]

[ghc-hetmet.git] / ghc / compiler / nativeGen / RegisterAlloc.hs

diff --git a/ghc/compiler/nativeGen/RegisterAlloc.hs b/ghc/compiler/nativeGen/RegisterAlloc.hs
index 1c58cdb..4f71fe1 100644 (file)
--- a/ghc/compiler/nativeGen/RegisterAlloc.hs
+++ b/ghc/compiler/nativeGen/RegisterAlloc.hs
@@ -62,9 +62,12 @@ The algorithm is roughly:
            and mark temporaries which have been spilled due to clobbering
            as in memory (step (a) marks then as in both mem & reg).
 
            and mark temporaries which have been spilled due to clobbering
            as in memory (step (a) marks then as in both mem & reg).
 

-       (g) For each temporary *written* (only) by this instruction:
+       (g) For each temporary *written* by this instruction:

            Allocate a real register as for (b), spilling something
            else if necessary.
            Allocate a real register as for (b), spilling something
            else if necessary.

+               - except when updating the assignment, drop any memory
+                 locations that the temporary was previously in, since
+                 they will be no longer valid after this instruction.

 
        (h) Delete all register assignments for temps which are
            written and die here (there should rarely be any).  Update
 
        (h) Delete all register assignments for temps which are
            written and die here (there should rarely be any).  Update

@@ -82,7 +85,6 @@ module RegisterAlloc (
   ) where
 
 #include "HsVersions.h"
   ) where
 
 #include "HsVersions.h"

-#include "../includes/ghcconfig.h"

 
 import PprMach
 import MachRegs
 
 import PprMach
 import MachRegs

@@ -427,10 +429,7 @@ genRaInsn block_live new_instrs instr r_dying w_dying = do
     let 
        RU read written = regUsage instr
 
     let 
        RU read written = regUsage instr
 

-        -- we're not interested in regs written if they're also read.
-       written' = nub (filter (`notElem` read) written)
-
-       (real_written1,virt_written) = partition isRealReg written'
+       (real_written1,virt_written) = partition isRealReg written

 
        real_written = [ r | RealReg r <- real_written1 ]
 
 
        real_written = [ r | RealReg r <- real_written1 ]
 

@@ -441,11 +440,13 @@ genRaInsn block_live new_instrs instr r_dying w_dying = do
     -- in
 
     -- (a) save any temporaries which will be clobbered by this instruction
     -- in
 
     -- (a) save any temporaries which will be clobbered by this instruction

-    (clobber_saves, assig_adj) <- saveClobberedTemps real_written r_dying
+    clobber_saves <- saveClobberedTemps real_written r_dying

 
 

-    -- freeregs <- getFreeRegsR
-    -- assig <- getAssigR
-    -- pprTrace "raInsn" (docToSDoc (pprInstr instr) $$ ppr r_dying <+> ppr w_dying $$ ppr virt_read <+> ppr virt_written $$ text (show freeregs) $$ ppr assig) $ do
+    {-
+    freeregs <- getFreeRegsR
+    assig <- getAssigR
+    pprTrace "raInsn" (docToSDoc (pprInstr instr) $$ ppr r_dying <+> ppr w_dying $$ ppr virt_read <+> ppr virt_written $$ text (show freeregs) $$ ppr assig) $ do
+    -}

 
     -- (b), (c) allocate real regs for all regs read by this instruction.
     (r_spills, r_allocd) <- 
 
     -- (b), (c) allocate real regs for all regs read by this instruction.
     (r_spills, r_allocd) <- 

@@ -463,7 +464,7 @@ genRaInsn block_live new_instrs instr r_dying w_dying = do
     releaseRegs r_dying
 
     -- (f) Mark regs which are clobbered as unallocatable
     releaseRegs r_dying
 
     -- (f) Mark regs which are clobbered as unallocatable

-    clobberRegs real_written assig_adj
+    clobberRegs real_written

 
     -- (g) Allocate registers for temporaries *written* (only)
     (w_spills, w_allocd) <- 
 
     -- (g) Allocate registers for temporaries *written* (only)
     (w_spills, w_allocd) <- 

@@ -529,12 +530,10 @@ for allocateRegs on the temps *written*,
 saveClobberedTemps
    :: [RegNo]             -- real registers clobbered by this instruction
    -> [Reg]               -- registers which are no longer live after this insn
 saveClobberedTemps
    :: [RegNo]             -- real registers clobbered by this instruction
    -> [Reg]               -- registers which are no longer live after this insn

-   -> RegM ( 
-       [Instr],           -- return: instructions to spill any temps that will
-       [(Unique,Loc)]     -- be clobbered, and adjustments to make to the 
-        )                 -- assignment after reading has taken place.
+   -> RegM [Instr]        -- return: instructions to spill any temps that will
+                          -- be clobbered.

 
 

-saveClobberedTemps [] _ = return ([],[]) -- common case
+saveClobberedTemps [] _ = return [] -- common case

 saveClobberedTemps clobbered dying =  do
   assig <- getAssigR
   let
 saveClobberedTemps clobbered dying =  do
   assig <- getAssigR
   let

@@ -542,26 +541,36 @@ saveClobberedTemps clobbered dying =  do
                                   reg `elem` clobbered,
                                   temp `notElem` map getUnique dying  ]
   -- in
                                   reg `elem` clobbered,
                                   temp `notElem` map getUnique dying  ]
   -- in

-  (instrs,assig_adj,assig') <- clobber assig [] [] to_spill
+  (instrs,assig') <- clobber assig [] to_spill

   setAssigR assig'
   setAssigR assig'

-  return (instrs,assig_adj)
+  return instrs

  where
  where

-  clobber assig instrs adj [] = return (instrs,adj,assig)
-  clobber assig instrs adj ((temp,reg):rest)
+  clobber assig instrs [] = return (instrs,assig)
+  clobber assig instrs ((temp,reg):rest)

     = do
     = do

-      (spill,slot) <- spillR (RealReg reg)
-      clobber (addToUFM assig temp (InBoth reg slot)) 
-        (spill:instrs) ((temp,InMem slot):adj) rest

        --ToDo: copy it to another register if possible
        --ToDo: copy it to another register if possible

+      (spill,slot) <- spillR (RealReg reg)
+      clobber (addToUFM assig temp (InBoth reg slot)) (spill:instrs) rest

 
 

-
-clobberRegs :: [RegNo] -> [(Unique,Loc)] -> RegM ()
-clobberRegs [] _ = return () -- common case
-clobberRegs clobbered assig_adj = do
+clobberRegs :: [RegNo] -> RegM ()
+clobberRegs [] = return () -- common case
+clobberRegs clobbered = do

   freeregs <- getFreeRegsR
   setFreeRegsR (foldl allocateReg freeregs clobbered)
   assig <- getAssigR
   freeregs <- getFreeRegsR
   setFreeRegsR (foldl allocateReg freeregs clobbered)
   assig <- getAssigR

-  setAssigR (addListToUFM assig assig_adj)
+  setAssigR $! clobber assig (ufmToList assig)
+ where
+    -- if the temp was InReg and clobbered, then we will have
+    -- saved it in saveClobberedTemps above.  So the only case
+    -- we have to worry about here is InBoth.  Note that this
+    -- also catches temps which were loaded up during allocation
+    -- of read registers, not just those saved in saveClobberedTemps.
+  clobber assig [] = assig
+  clobber assig ((temp, InBoth reg slot) : rest)
+       | reg `elem` clobbered
+       = clobber (addToUFM assig temp (InMem slot)) rest
+  clobber assig (entry:rest)
+       = clobber assig rest 

 
 -- -----------------------------------------------------------------------------
 -- allocateRegsAndSpill
 
 -- -----------------------------------------------------------------------------
 -- allocateRegsAndSpill

@@ -592,10 +601,12 @@ allocateRegsAndSpill reading keep spills alloc (r:rs) = do
        allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
 
   -- case (1b): already in a register (and memory)
        allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
 
   -- case (1b): already in a register (and memory)

-  -- NB. if we're writing this register, update its assignemnt to be
+  -- NB1. if we're writing this register, update its assignemnt to be

   -- InReg, because the memory value is no longer valid.
   -- InReg, because the memory value is no longer valid.

+  -- NB2. This is why we must process written registers here, even if they
+  -- are also read by the same instruction.

      Just (InBoth my_reg mem) -> do
      Just (InBoth my_reg mem) -> do

-       when (not reading) (setAssigR (addToUFM assig my_reg (InReg my_reg)))
+       when (not reading) (setAssigR (addToUFM assig r (InReg my_reg)))

        allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
 
   -- Not already in a register, so we need to find a free one...
        allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
 
   -- Not already in a register, so we need to find a free one...

@@ -607,9 +618,9 @@ allocateRegsAndSpill reading keep spills alloc (r:rs) = do
        -- case (2): we have a free register
          my_reg:_ -> do
            spills'   <- do_load reading loc my_reg spills
        -- case (2): we have a free register
          my_reg:_ -> do
            spills'   <- do_load reading loc my_reg spills

-           let new_loc = case loc of
-                               Just (InMem slot) -> InBoth my_reg slot
-                               _other            -> InReg my_reg
+           let new_loc 
+                | Just (InMem slot) <- loc, reading = InBoth my_reg slot
+                | otherwise                         = InReg my_reg

            setAssigR (addToUFM assig r $! new_loc)
            setFreeRegsR (allocateReg freeregs my_reg)
            allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs
            setAssigR (addToUFM assig r $! new_loc)
            setFreeRegsR (allocateReg freeregs my_reg)
            allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs