From 47f809644d5ccba8be7a27a9d8ebbb818cac33ef Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Thu, 29 Jun 2006 12:02:10 +0000 Subject: [PATCH] fix some problems with the fixup block code We weren't handling InBoth properly. InBoth needs to be expanded to appropriate InReg/InMem locations *before* building the interference graph, otherwise an InBoth will not be seen to conflict with other InReg/InMem locations. --- compiler/nativeGen/RegisterAlloc.hs | 68 +++++++++++++++++++++-------------- 1 file changed, 41 insertions(+), 27 deletions(-) diff --git a/compiler/nativeGen/RegisterAlloc.hs b/compiler/nativeGen/RegisterAlloc.hs index 1e5f7ed..bbab518 100644 --- a/compiler/nativeGen/RegisterAlloc.hs +++ b/compiler/nativeGen/RegisterAlloc.hs @@ -861,42 +861,56 @@ joinToTargets block_live new_blocks instr (dest:dests) = do -- make sure that every temporary always gets its own -- stack slot. - let graph = [ (loc0, loc0, - [lookupWithDefaultUFM_Directly - dest_assig - (panic "RegisterAlloc.joinToTargets") - vreg] - ) - | (vreg, loc0) <- ufmToList adjusted_assig ] + let graph = [ node | (vreg, src) <- ufmToList adjusted_assig, + node <- mkNodes src vreg ] + sccs = stronglyConnCompR graph - handleComponent (CyclicSCC [one]) = [] - handleComponent (AcyclicSCC (src,_,[dst])) - = makeMove src dst + mkNodes src vreg = + expandNode src (lookupWithDefaultUFM_Directly + dest_assig + (panic "RegisterAlloc.joinToTargets") + vreg) + + -- The InBoth handling is a little tricky here. If + -- the destination is InBoth, then we must ensure that + -- the value ends up in both locations. An InBoth + -- destination must conflict with an InReg or InMem + -- source, so we expand an InBoth destination as + -- necessary. An InBoth source is slightly different: + -- we only care about the register that the source value + -- is in, so that we can move it to the destinations. + + expandNode loc@(InReg src) (InBoth dst mem) + | src == dst = [(loc, loc, [InMem dst])] + | otherwise = [(loc, loc, [InReg dst, InMem mem])] + expandNode loc@(InMem src) (InBoth dst mem) + | src == mem = [(loc, loc, [InReg dst])] + | otherwise = [(loc, loc, [InReg dst, InMem mem])] + expandNode loc@(InBoth _ src) (InMem dst) + | src == dst = [] -- guaranteed to be true + expandNode loc@(InBoth src _) (InReg dst) + | src == dst = [] + expandNode loc@(InBoth src _) dst + = expandNode (InReg src) dst + expandNode src dst + | src == dst = [] + | otherwise = [(src, src, [dst])] + + -- we have eliminated any possibility of single-node cylces + -- in expandNode above. + handleComponent (AcyclicSCC (src,_,dsts)) + = map (makeMove src) dsts handleComponent (CyclicSCC things) = panic $ "Register Allocator: handleComponent: cyclic" ++ " (workaround: use -fviaC)" makeMove (InReg src) (InReg dst) - = [mkRegRegMoveInstr (RealReg src) (RealReg dst)] + = mkRegRegMoveInstr (RealReg src) (RealReg dst) makeMove (InMem src) (InReg dst) - = [mkLoadInstr (RealReg dst) delta src] + = mkLoadInstr (RealReg dst) delta src makeMove (InReg src) (InMem dst) - = [mkSpillInstr (RealReg src) delta dst] - - makeMove (InBoth src _) (InReg dst) - | src == dst = [] - makeMove (InBoth _ src) (InMem dst) - | src == dst = [] - makeMove (InBoth src _) dst - = makeMove (InReg src) dst - makeMove (InReg src) (InBoth dstR dstM) - | src == dstR - = makeMove (InReg src) (InMem dstM) - | otherwise - = makeMove (InReg src) (InReg dstR) - ++ makeMove (InReg src) (InMem dstM) - + = mkSpillInstr (RealReg src) delta dst makeMove src dst = panic $ "makeMove (" ++ show src ++ ") (" ++ show dst ++ ")" -- 1.7.10.4