X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FRegisterAlloc.hs;h=4f71fe1edb3b255cc2e15c690d0a7cf16b9ef203;hb=153b9cb9b11e05c4edb1b6bc0a7b972660e41f70;hp=1c58cdb81f4008f9bb75296e2516d0961b89c97f;hpb=423d477bfecd490de1449c59325c8776f91d7aac;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/RegisterAlloc.hs b/ghc/compiler/nativeGen/RegisterAlloc.hs index 1c58cdb..4f71fe1 100644 --- 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). - (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 @@ -82,7 +85,6 @@ module RegisterAlloc ( ) where #include "HsVersions.h" -#include "../includes/ghcconfig.h" 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 - -- 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 ] @@ -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 - (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) <- @@ -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 - clobberRegs real_written assig_adj + clobberRegs real_written -- (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 - -> 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 @@ -542,26 +541,36 @@ saveClobberedTemps clobbered dying = do 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 @@ -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) - -- 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... @@ -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 - 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