From e2cb835efb2e2a588bf27136929adba868d853ec Mon Sep 17 00:00:00 2001 From: Andreas Klebinger Date: Mon, 19 Jul 2021 18:12:44 +0200 Subject: NCG: Linear-reg-alloc: A few small implemenation tweaks. Removed an intermediate list via a fold. realRegsAlias: Manually inlined the list functions to get better code. Linear.hs added a bang somewhere. --- compiler/GHC/CmmToAsm/Reg/Linear.hs | 40 +++++++++++++++++++------------------ compiler/GHC/Platform/Reg.hs | 14 ++++++++++--- compiler/GHC/Types/Unique/FM.hs | 11 +++++++--- 3 files changed, 40 insertions(+), 25 deletions(-) diff --git a/compiler/GHC/CmmToAsm/Reg/Linear.hs b/compiler/GHC/CmmToAsm/Reg/Linear.hs index a9a4545f62..021c909a52 100644 --- a/compiler/GHC/CmmToAsm/Reg/Linear.hs +++ b/compiler/GHC/CmmToAsm/Reg/Linear.hs @@ -677,29 +677,30 @@ saveClobberedTemps [] _ saveClobberedTemps clobbered dying = do assig <- getAssigR :: RegM freeRegs (UniqFM Reg Loc) - -- Unique represents the VirtualReg - let to_spill :: [(Unique, RealReg)] - to_spill - = [ (temp,reg) - | (temp, InReg reg) <- nonDetUFMToList assig - -- This is non-deterministic but we do not - -- currently support deterministic code-generation. - -- See Note [Unique Determinism and code generation] - , any (realRegsAlias reg) clobbered - , temp `notElem` map getUnique dying ] - - (instrs,assig') <- clobber assig [] to_spill + (assig',instrs) <- nonDetStrictFoldUFM_DirectlyM maybe_spill (assig,[]) assig setAssigR assig' return $ -- mkComment (text "") ++ instrs -- ++ mkComment (text "") where - -- See Note [UniqFM and the register allocator] - clobber :: RegMap Loc -> [instr] -> [(Unique,RealReg)] -> RegM freeRegs ([instr], RegMap Loc) - clobber assig instrs [] - = return (instrs, assig) + -- Unique represents the VirtualReg + -- Here we separate the cases which we do want to spill from these we don't. + maybe_spill :: Unique -> (RegMap Loc,[instr]) -> (Loc) -> RegM freeRegs (RegMap Loc,[instr]) + maybe_spill !temp !(assig,instrs) !loc = + case loc of + -- This is non-deterministic but we do not + -- currently support deterministic code-generation. + -- See Note [Unique Determinism and code generation] + InReg reg + | any (realRegsAlias reg) clobbered + , temp `notElem` map getUnique dying + -> clobber temp (assig,instrs) (reg) + _ -> return (assig,instrs) - clobber assig instrs ((temp, reg) : rest) + + -- See Note [UniqFM and the register allocator] + clobber :: Unique -> (RegMap Loc,[instr]) -> (RealReg) -> RegM freeRegs (RegMap Loc,[instr]) + clobber temp (assig,instrs) (reg) = do platform <- getPlatform freeRegs <- getFreeRegsR @@ -718,7 +719,7 @@ saveClobberedTemps clobbered dying let instr = mkRegRegMoveInstr platform (RegReal reg) (RegReal my_reg) - clobber new_assign (instr : instrs) rest + return (new_assign,(instr : instrs)) -- (2) no free registers: spill the value [] -> do @@ -729,7 +730,8 @@ saveClobberedTemps clobbered dying let new_assign = addToUFM_Directly assig temp (InBoth reg slot) - clobber new_assign (spill ++ instrs) rest + return (new_assign, (spill ++ instrs)) + diff --git a/compiler/GHC/Platform/Reg.hs b/compiler/GHC/Platform/Reg.hs index 5edd39df51..8203b9bbea 100644 --- a/compiler/GHC/Platform/Reg.hs +++ b/compiler/GHC/Platform/Reg.hs @@ -34,7 +34,6 @@ import GHC.Utils.Panic import GHC.Types.Unique import GHC.Builtin.Uniques import GHC.Platform.Reg.Class -import Data.List (intersect) -- | An identifier for a primitive real machine register. type RegNo @@ -173,8 +172,17 @@ regNosOfRealReg rr realRegsAlias :: RealReg -> RealReg -> Bool -realRegsAlias rr1 rr2 - = not $ null $ intersect (regNosOfRealReg rr1) (regNosOfRealReg rr2) +realRegsAlias rr1 rr2 = + -- used to be `not $ null $ intersect (regNosOfRealReg rr1) (regNosOfRealReg rr2)` + -- but that resulted in some gnarly, gnarly, allocating code. So we manually + -- write out all the cases which gives us nice non-allocating code. + case rr1 of + RealRegSingle r1 -> + case rr2 of RealRegPair r2 r3 -> r1 == r2 || r1 == r3 + RealRegSingle r2 -> r1 == r2 + RealRegPair r1 r2 -> + case rr2 of RealRegPair r3 r4 -> r1 == r3 || r1 == r4 || r2 == r3 || r2 == r4 + RealRegSingle r3 -> r1 == r3 || r2 == r3 -------------------------------------------------------------------------------- -- | A register, either virtual or real diff --git a/compiler/GHC/Types/Unique/FM.hs b/compiler/GHC/Types/Unique/FM.hs index 7c80359d0e..0d43111c2a 100644 --- a/compiler/GHC/Types/Unique/FM.hs +++ b/compiler/GHC/Types/Unique/FM.hs @@ -63,7 +63,7 @@ module GHC.Types.Unique.FM ( intersectUFM_C, disjointUFM, equalKeysUFM, - nonDetStrictFoldUFM, foldUFM, nonDetStrictFoldUFM_Directly, + nonDetStrictFoldUFM, foldUFM, nonDetStrictFoldUFM_DirectlyM, anyUFM, allUFM, seqEltsUFM, mapUFM, mapUFM_Directly, elemUFM, elemUFM_Directly, @@ -405,11 +405,16 @@ nonDetKeysUFM (UFM m) = map getUnique $ M.keys m nonDetStrictFoldUFM :: (elt -> a -> a) -> a -> UniqFM key elt -> a nonDetStrictFoldUFM k z (UFM m) = M.foldl' (flip k) z m +-- | In essence foldM -- See Note [Deterministic UniqFM] to learn about nondeterminism. -- If you use this please provide a justification why it doesn't introduce -- nondeterminism. -nonDetStrictFoldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM key elt -> a -nonDetStrictFoldUFM_Directly k z (UFM m) = M.foldlWithKey' (\z' i x -> k (getUnique i) x z') z m +{-# INLINE nonDetStrictFoldUFM_DirectlyM #-} -- Allow specialization +nonDetStrictFoldUFM_DirectlyM :: (Monad m) => (Unique -> b -> elt -> m b) -> b -> UniqFM key elt -> m b +nonDetStrictFoldUFM_DirectlyM f z0 (UFM xs) = M.foldrWithKey c return xs z0 + -- See Note [List fusion and continuations in 'c'] + where c u x k z = f (getUnique u) z x >>= k + {-# INLINE c #-} -- See Note [Deterministic UniqFM] to learn about nondeterminism. -- If you use this please provide a justification why it doesn't introduce -- cgit v1.2.1