Commit e3029b1d authored by Ben.Lippmeier@anu.edu.au's avatar Ben.Lippmeier@anu.edu.au
Browse files

NCG: Split block reorder thing in linear allocator into separate fn

parent 4fb7d5ba
......@@ -152,8 +152,8 @@ joinToTargets_again
--
let sccs = stronglyConnCompFromEdgedVerticesR graph
-- debugging
{- pprTrace
{- -- debugging
pprTrace
("joinToTargets: making fixup code")
(vcat [ text " in block: " <> ppr block_id
, text " jmp instruction: " <> ppr instr
......
......@@ -194,19 +194,42 @@ linearRA_SCCs first_id block_live blocksAcc (AcyclicSCC block : sccs)
sccs
linearRA_SCCs first_id block_live blocksAcc (CyclicSCC blocks : sccs)
= do let process [] [] accum = return $ reverse accum
process [] next_round accum = process next_round [] accum
process (b@(BasicBlock id _) : blocks) next_round accum =
do block_assig <- getBlockAssigR
if isJust (lookupBlockEnv block_assig id) || id == first_id
then do b' <- processBlock block_live b
process blocks next_round (b' : accum)
else process blocks (b : next_round) accum
blockss' <- process blocks [] (return [])
= do
blockss' <- process first_id block_live blocks [] (return [])
linearRA_SCCs first_id block_live
(reverse (concat blockss') ++ blocksAcc)
sccs
{- from John Dias's patch 2008/10/16:
The linear-scan allocator sometimes allocates a block
before allocating one of its predecessors, which could lead to
inconsistent allocations. Make it so a block is only allocated
if a predecessor has set the "incoming" assignments for the block, or
if it's the procedure's entry block.
BL 2009/02: Careful. If the assignment for a block doesn't get set for
some reason then this function will loop. We should probably do some
more sanity checking to guard against this eventuality.
-}
process _ _ [] [] accum
= return $ reverse accum
process first_id block_live [] next_round accum
= process first_id block_live next_round [] accum
process first_id block_live (b@(BasicBlock id _) : blocks) next_round accum
= do
block_assig <- getBlockAssigR
if isJust (lookupBlockEnv block_assig id)
|| id == first_id
then do
b' <- processBlock block_live b
process first_id block_live blocks next_round (b' : accum)
else process first_id block_live blocks (b : next_round) accum
-- | Do register allocation on this basic block
--
......@@ -219,7 +242,6 @@ processBlock block_live (BasicBlock id instrs)
= do initBlock id
(instrs', fixups)
<- linearRA block_live [] [] id instrs
return $ BasicBlock id instrs' : fixups
......@@ -348,9 +370,9 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying =
clobber_saves <- saveClobberedTemps real_written r_dying
{- freeregs <- getFreeRegsR
assig <- getAssigR
pprTrace "raInsn"
{- freeregs <- getFreeRegsR
assig <- getAssigR
pprTrace "genRaInsn"
(docToSDoc (pprInstr instr) $$ ppr r_dying <+> ppr w_dying $$ ppr virt_read <+> ppr virt_written
$$ text (show freeregs) $$ ppr assig)
$ do
......@@ -394,7 +416,7 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying =
Just y -> y
-- in
-- pprTrace "patched" (docToSDoc (pprInstr patched_instr)) $ do
-- pprTrace "patched" (docToSDoc (pprInstr patched_instr)) $ do
-- (j) free up stack slots for dead spilled regs
-- TODO (can't be bothered right now)
......@@ -402,14 +424,19 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying =
-- erase reg->reg moves where the source and destination are the same.
-- If the src temp didn't die in this instr but happened to be allocated
-- to the same real reg as the destination, then we can erase the move anyway.
squashed_instr = case isRegRegMove patched_instr of
let squashed_instr = case isRegRegMove patched_instr of
Just (src, dst)
| src == dst -> []
_ -> [patched_instr]
return (squashed_instr ++ w_spills ++ reverse r_spills
++ clobber_saves ++ new_instrs,
fixup_blocks)
let code = squashed_instr ++ w_spills ++ reverse r_spills
++ clobber_saves ++ new_instrs
-- pprTrace "patched-code" ((vcat $ map (docToSDoc . pprInstr) code)) $ do
-- pprTrace "pached-fixup" ((ppr fixup_blocks)) $ do
return (code, fixup_blocks)
}}
-- -----------------------------------------------------------------------------
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment