[Git][ghc/ghc][wip/ncg-simd] fix X86 takeRegRegMove
sheaf (@sheaf)
gitlab at gitlab.haskell.org
Thu Jun 13 15:48:18 UTC 2024
sheaf pushed to branch wip/ncg-simd at Glasgow Haskell Compiler / GHC
Commits:
6ca1b8e0 by sheaf at 2024-06-13T17:48:07+02:00
fix X86 takeRegRegMove
- - - - -
12 changed files:
- compiler/GHC/CmmToAsm.hs
- compiler/GHC/CmmToAsm/AArch64.hs
- compiler/GHC/CmmToAsm/Instr.hs
- compiler/GHC/CmmToAsm/PPC.hs
- compiler/GHC/CmmToAsm/Reg/Graph.hs
- compiler/GHC/CmmToAsm/Reg/Graph/Coalesce.hs
- compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
- compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
- compiler/GHC/CmmToAsm/Reg/Linear.hs
- compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs
- compiler/GHC/CmmToAsm/Reg/Liveness.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
Changes:
=====================================
compiler/GHC/CmmToAsm.hs
=====================================
@@ -240,6 +240,7 @@ finishNativeGen logger config modLoc bufh us ngs
-- dump global NCG stats for graph coloring allocator
let stats = concat (ngs_colorStats ngs)
+ platform = ncgPlatform config
unless (null stats) $ do
-- build the global register conflict graph
@@ -250,7 +251,7 @@ finishNativeGen logger config modLoc bufh us ngs
dump_stats (Color.pprStats stats graphGlobal)
- let platform = ncgPlatform config
+
putDumpFileMaybe logger
Opt_D_dump_asm_conflicts "Register conflict graph"
FormatText
@@ -265,7 +266,7 @@ finishNativeGen logger config modLoc bufh us ngs
-- dump global NCG stats for linear allocator
let linearStats = concat (ngs_linearStats ngs)
unless (null linearStats) $
- dump_stats (Linear.pprStats (concat (ngs_natives ngs)) linearStats)
+ dump_stats (Linear.pprStats platform (concat (ngs_natives ngs)) linearStats)
-- write out the imports
let ctx = ncgAsmContext config
=====================================
compiler/GHC/CmmToAsm/AArch64.hs
=====================================
@@ -54,7 +54,7 @@ instance Instruction AArch64.Instr where
takeDeltaInstr = AArch64.takeDeltaInstr
isMetaInstr = AArch64.isMetaInstr
mkRegRegMoveInstr _ = AArch64.mkRegRegMoveInstr
- takeRegRegMoveInstr = AArch64.takeRegRegMoveInstr
+ takeRegRegMoveInstr _ = AArch64.takeRegRegMoveInstr
mkJumpInstr = AArch64.mkJumpInstr
mkStackAllocInstr = AArch64.mkStackAllocInstr
mkStackDeallocInstr = AArch64.mkStackDeallocInstr
=====================================
compiler/GHC/CmmToAsm/Instr.hs
=====================================
@@ -142,7 +142,8 @@ class Instruction instr where
-- | Take the source and destination from this reg -> reg move instruction
-- or Nothing if it's not one
takeRegRegMoveInstr
- :: instr
+ :: Platform
+ -> instr
-> Maybe (Reg, Reg)
-- | Make an unconditional jump instruction.
=====================================
compiler/GHC/CmmToAsm/PPC.hs
=====================================
@@ -53,7 +53,7 @@ instance Instruction PPC.Instr where
takeDeltaInstr = PPC.takeDeltaInstr
isMetaInstr = PPC.isMetaInstr
mkRegRegMoveInstr _ = PPC.mkRegRegMoveInstr
- takeRegRegMoveInstr = PPC.takeRegRegMoveInstr
+ takeRegRegMoveInstr _ = PPC.takeRegRegMoveInstr
mkJumpInstr = PPC.mkJumpInstr
mkStackAllocInstr = PPC.mkStackAllocInstr
mkStackDeallocInstr = PPC.mkStackDeallocInstr
=====================================
compiler/GHC/CmmToAsm/Reg/Graph.hs
=====================================
@@ -140,7 +140,7 @@ regAlloc_spin config spinCount triv regsFree slotsFree slotsCount debug_codeGrap
-- Build the register conflict graph from the cmm code.
(graph :: Color.Graph VirtualReg RegClass RealReg)
- <- {-# SCC "BuildGraph" #-} buildGraph code
+ <- {-# SCC "BuildGraph" #-} buildGraph platform code
-- VERY IMPORTANT:
-- We really do want the graph to be fully evaluated _before_ we
@@ -188,7 +188,7 @@ regAlloc_spin config spinCount triv regsFree slotsFree slotsCount debug_codeGrap
= reg
let (code_coalesced :: [LiveCmmDecl statics instr])
- = map (patchEraseLive patchF) code
+ = map (patchEraseLive platform patchF) code
-- Check whether we've found a coloring.
if isEmptyUniqSet rsSpill
@@ -234,7 +234,7 @@ regAlloc_spin config spinCount triv regsFree slotsFree slotsCount debug_codeGrap
, raSpillClean = code_spillclean
, raFinal = code_final
, raSRMs = foldl' addSRM (0, 0, 0)
- $ map countSRMs code_spillclean
+ $ map (countSRMs platform) code_spillclean
, raPlatform = platform
}
@@ -304,14 +304,15 @@ regAlloc_spin config spinCount triv regsFree slotsFree slotsCount debug_codeGrap
-- | Build a graph from the liveness and coalesce information in this code.
buildGraph
:: Instruction instr
- => [LiveCmmDecl statics instr]
+ => Platform
+ -> [LiveCmmDecl statics instr]
-> UniqSM (Color.Graph VirtualReg RegClass RealReg)
-buildGraph code
+buildGraph platform code
= do
-- Slurp out the conflicts and reg->reg moves from this code.
let (conflictList, moveList) =
- unzip $ map slurpConflicts code
+ unzip $ map (slurpConflicts platform) code
-- Slurp out the spill/reload coalesces.
let moveList2 = map slurpReloadCoalesce code
@@ -393,7 +394,7 @@ patchRegsFromGraph
-> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
patchRegsFromGraph platform graph code
- = patchEraseLive patchF code
+ = patchEraseLive platform patchF code
where
-- Function to lookup the hardreg for a virtual reg from the graph.
patchF reg
=====================================
compiler/GHC/CmmToAsm/Reg/Graph/Coalesce.hs
=====================================
@@ -14,6 +14,7 @@ import GHC.Data.Bag
import GHC.Data.Graph.Directed
import GHC.Types.Unique.FM
import GHC.Types.Unique.Supply
+import GHC.Platform (Platform)
-- | Do register coalescing on this top level thing
@@ -24,18 +25,19 @@ import GHC.Types.Unique.Supply
-- safely erased.
regCoalesce
:: Instruction instr
- => [LiveCmmDecl statics instr]
+ => Platform
+ -> [LiveCmmDecl statics instr]
-> UniqSM [LiveCmmDecl statics instr]
-regCoalesce code
+regCoalesce platform code
= do
let joins = foldl' unionBags emptyBag
- $ map slurpJoinMovs code
+ $ map (slurpJoinMovs platform) code
let alloc = foldl' buildAlloc emptyUFM
$ bagToList joins
- let patched = map (patchEraseLive (sinkReg alloc)) code
+ let patched = map (patchEraseLive platform (sinkReg alloc)) code
return patched
@@ -66,10 +68,11 @@ sinkReg fm r
-- eliminate the move.
slurpJoinMovs
:: Instruction instr
- => LiveCmmDecl statics instr
+ => Platform
+ -> LiveCmmDecl statics instr
-> Bag (Reg, Reg)
-slurpJoinMovs live
+slurpJoinMovs platform live
= slurpCmm emptyBag live
where
slurpCmm rs CmmData{}
@@ -83,7 +86,7 @@ slurpJoinMovs live
slurpLI rs (LiveInstr _ Nothing) = rs
slurpLI rs (LiveInstr instr (Just live))
- | Just (r1, r2) <- takeRegRegMoveInstr instr
+ | Just (r1, r2) <- takeRegRegMoveInstr platform instr
, elemUFM r1 $ liveDieRead live
, elemUFM r2 $ liveBorn live
=====================================
compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
=====================================
@@ -171,7 +171,7 @@ cleanForward platform blockId assoc acc (li1 : li2 : instrs)
-- SIMD NCG TODO: is this "fmt" correct?
cleanForward platform blockId assoc acc (li@(LiveInstr i1 _) : instrs)
- | Just (r1, r2) <- takeRegRegMoveInstr i1
+ | Just (r1, r2) <- takeRegRegMoveInstr platform i1
= if r1 == r2
-- Erase any left over nop reg reg moves while we're here
-- this will also catch any nop moves that the previous case
=====================================
compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
=====================================
@@ -312,27 +312,29 @@ pprStatsLifeConflict stats graph
-- Lets us see how well the register allocator has done.
countSRMs
:: Instruction instr
- => LiveCmmDecl statics instr -> (Int, Int, Int)
+ => Platform
+ -> LiveCmmDecl statics instr -> (Int, Int, Int)
-countSRMs cmm
- = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)
+countSRMs platform cmm
+ = execState (mapBlockTopM (countSRM_block platform) cmm) (0, 0, 0)
countSRM_block
:: Instruction instr
- => GenBasicBlock (LiveInstr instr)
+ => Platform
+ -> GenBasicBlock (LiveInstr instr)
-> State (Int, Int, Int) (GenBasicBlock (LiveInstr instr))
-countSRM_block (BasicBlock i instrs)
- = do instrs' <- mapM countSRM_instr instrs
+countSRM_block platform (BasicBlock i instrs)
+ = do instrs' <- mapM (countSRM_instr platform) instrs
return $ BasicBlock i instrs'
countSRM_instr
:: Instruction instr
- => LiveInstr instr -> State (Int, Int, Int) (LiveInstr instr)
+ => Platform -> LiveInstr instr -> State (Int, Int, Int) (LiveInstr instr)
-countSRM_instr li
+countSRM_instr platform li
| LiveInstr SPILL{} _ <- li
= do modify $ \(s, r, m) -> (s + 1, r, m)
return li
@@ -342,7 +344,7 @@ countSRM_instr li
return li
| LiveInstr instr _ <- li
- , Just _ <- takeRegRegMoveInstr instr
+ , Just _ <- takeRegRegMoveInstr platform instr
= do modify $ \(s, r, m) -> (s, r, m + 1)
return li
=====================================
compiler/GHC/CmmToAsm/Reg/Linear.hs
=====================================
@@ -422,6 +422,7 @@ raInsn _ new_instrs _ (LiveInstr ii@(Instr i) Nothing)
raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
= do
+ platform <- getPlatform
assig <- getAssigR :: RegM freeRegs (UniqFM Reg Loc)
-- If we have a reg->reg move between virtual registers, where the
@@ -431,7 +432,7 @@ raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
-- then we can eliminate the instruction.
-- (we can't eliminate it if the source register is on the stack, because
-- we do not want to use one spill slot for different virtual registers)
- case takeRegRegMoveInstr instr of
+ case takeRegRegMoveInstr platform instr of
Just (src,dst) | Just (_, fmt) <- lookupUFM (liveDieRead live) src,
isVirtualReg dst,
not (dst `elemUFM` assig),
@@ -585,7 +586,7 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying = do
-- 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.
- let squashed_instr = case takeRegRegMoveInstr patched_instr of
+ let squashed_instr = case takeRegRegMoveInstr platform patched_instr of
Just (src, dst)
| src == dst -> []
_ -> [patched_instr]
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs
=====================================
@@ -18,6 +18,7 @@ import GHC.Types.Unique.FM
import GHC.Utils.Outputable
import GHC.Utils.Monad.State.Strict
+import GHC.Platform (Platform)
-- | Build a map of how many times each reg was alloced, clobbered, loaded etc.
binSpillReasons
@@ -38,9 +39,10 @@ binSpillReasons reasons
-- | Count reg-reg moves remaining in this code.
countRegRegMovesNat
:: Instruction instr
- => NatCmmDecl statics instr -> Int
+ => Platform
+ -> NatCmmDecl statics instr -> Int
-countRegRegMovesNat cmm
+countRegRegMovesNat platform cmm
= execState (mapGenBlockTopM countBlock cmm) 0
where
countBlock b@(BasicBlock _ instrs)
@@ -48,7 +50,7 @@ countRegRegMovesNat cmm
return b
countInstr instr
- | Just _ <- takeRegRegMoveInstr instr
+ | Just _ <- takeRegRegMoveInstr platform instr
= do modify (+ 1)
return instr
@@ -59,9 +61,9 @@ countRegRegMovesNat cmm
-- | Pretty print some RegAllocStats
pprStats
:: Instruction instr
- => [NatCmmDecl statics instr] -> [RegAllocStats] -> SDoc
+ => Platform -> [NatCmmDecl statics instr] -> [RegAllocStats] -> SDoc
-pprStats code statss
+pprStats platform code statss
= let -- sum up all the instrs inserted by the spiller
-- See Note [UniqFM and the register allocator]
spills :: UniqFM Unique [Int]
@@ -75,7 +77,7 @@ pprStats code statss
-- See Note [Unique Determinism and code generation]
-- count how many reg-reg-moves remain in the code
- moves = sum $ map countRegRegMovesNat code
+ moves = sum $ map (countRegRegMovesNat platform) code
pprSpill (reg, spills)
= parens $ (hcat $ punctuate (text ", ") (doubleQuotes (ppr reg) : map ppr spills))
=====================================
compiler/GHC/CmmToAsm/Reg/Liveness.hs
=====================================
@@ -156,9 +156,9 @@ instance Instruction instr => Instruction (InstrSR instr) where
mkRegRegMoveInstr platform fmt r1 r2
= Instr (mkRegRegMoveInstr platform fmt r1 r2)
- takeRegRegMoveInstr i
+ takeRegRegMoveInstr platform i
= case i of
- Instr instr -> takeRegRegMoveInstr instr
+ Instr instr -> takeRegRegMoveInstr platform instr
_ -> Nothing
mkJumpInstr target = map Instr (mkJumpInstr target)
@@ -327,10 +327,11 @@ mapGenBlockTopM f (CmmProc header label live (ListGraph blocks))
--
slurpConflicts
:: Instruction instr
- => LiveCmmDecl statics instr
+ => Platform
+ -> LiveCmmDecl statics instr
-> (Bag (UniqFM Reg (Reg, Format)), Bag (Reg, Reg))
-slurpConflicts live
+slurpConflicts platform live
= slurpCmm (emptyBag, emptyBag) live
where slurpCmm rs CmmData{} = rs
@@ -380,7 +381,7 @@ slurpConflicts live
--
rsConflicts = plusUFM rsLiveNext rsOrphans
- in case takeRegRegMoveInstr instr of
+ in case takeRegRegMoveInstr platform instr of
Just rr -> slurpLIs rsLiveNext
( consBag rsConflicts conflicts
, consBag rr moves) lis
@@ -609,10 +610,11 @@ eraseDeltasLive cmm
-- also erase reg -> reg moves when the destination dies in this instr.
patchEraseLive
:: Instruction instr
- => (Reg -> Reg)
+ => Platform
+ -> (Reg -> Reg)
-> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
-patchEraseLive patchF cmm
+patchEraseLive platform patchF cmm
= patchCmm cmm
where
patchCmm cmm at CmmData{} = cmm
@@ -636,7 +638,7 @@ patchEraseLive patchF cmm
patchInstrs (li : lis)
| LiveInstr i (Just live) <- li'
- , Just (r1, r2) <- takeRegRegMoveInstr i
+ , Just (r1, r2) <- takeRegRegMoveInstr platform i
, eatMe r1 r2 live
= patchInstrs lis
=====================================
compiler/GHC/CmmToAsm/X86/Instr.hs
=====================================
@@ -67,6 +67,7 @@ import GHC.Types.Basic (Alignment)
import GHC.Cmm.DebugBlock (UnwindTable)
import Data.Maybe (fromMaybe)
+import GHC.CmmToAsm.Reg.Target (targetClassOfReg)
-- Format of an x86/x86_64 memory address, in bytes.
--
@@ -976,29 +977,33 @@ mkRegRegMoveInstr _platform fmt src dst
-- by assigning the src and dest temporaries to the same real register.
--
takeRegRegMoveInstr
- :: Instr
+ :: Platform
+ -> Instr
-> Maybe (Reg,Reg)
-takeRegRegMoveInstr (MOV fmt (OpReg r1) (OpReg r2))
+takeRegRegMoveInstr platform (MOV fmt (OpReg r1) (OpReg r2))
-- MOV zeroes the upper part of vector registers,
-- so it is not a real "move" in that case.
| not (isVecFormat fmt)
+ -- Don't eliminate a move between e.g. RAX and XMM,
+ -- even though we might be using XMM to store a scalar integer value.
+ , targetClassOfReg platform r1 == targetClassOfReg platform r2
= Just (r1,r2)
-takeRegRegMoveInstr (MOVSD fmt (OpReg r1) (OpReg r2))
+takeRegRegMoveInstr _ (MOVSD fmt (OpReg r1) (OpReg r2))
| not (isVecFormat fmt)
= Just (r1,r2)
-takeRegRegMoveInstr (MOVA _ (OpReg r1) (OpReg r2))
+takeRegRegMoveInstr _ (MOVA _ (OpReg r1) (OpReg r2))
= Just (r1, r2)
-takeRegRegMoveInstr (MOVU _ (OpReg r1) (OpReg r2))
+takeRegRegMoveInstr _ (MOVU _ (OpReg r1) (OpReg r2))
= Just (r1, r2)
-takeRegRegMoveInstr (VMOVU _ (OpReg r1) (OpReg r2))
+takeRegRegMoveInstr _ (VMOVU _ (OpReg r1) (OpReg r2))
= Just (r1, r2)
-takeRegRegMoveInstr (MOVDQU _ (OpReg r1) (OpReg r2))
+takeRegRegMoveInstr _ (MOVDQU _ (OpReg r1) (OpReg r2))
= Just (r1, r2)
-takeRegRegMoveInstr (VMOVDQU _ (OpReg r1) (OpReg r2))
+takeRegRegMoveInstr _ (VMOVDQU _ (OpReg r1) (OpReg r2))
= Just (r1, r2)
-takeRegRegMoveInstr _ = Nothing
+takeRegRegMoveInstr _ _ = Nothing
-- | Make an unconditional branch instruction.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ca1b8e083cee1fff5e9516bbd15f39c83de3344
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ca1b8e083cee1fff5e9516bbd15f39c83de3344
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240613/b9b8e32e/attachment-0001.html>
More information about the ghc-commits
mailing list