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.
+ - 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
) where
#include "HsVersions.h"
-#include "../includes/ghcconfig.h"
import PprMach
import MachRegs
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 ]
-- 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) <-
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) <-
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
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'
- return (instrs,assig_adj)
+ return instrs
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
- (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
+ (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
- 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 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.
+ -- 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
- 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...
-- 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
projects / ghc-hetmet.git / blobdiff