[Git][ghc/ghc][wip/ncg-simd] simd fixups
sheaf (@sheaf)
gitlab at gitlab.haskell.org
Thu Jun 20 12:22:59 UTC 2024
sheaf pushed to branch wip/ncg-simd at Glasgow Haskell Compiler / GHC
Commits:
a012d5e4 by sheaf at 2024-06-20T14:22:41+02:00
simd fixups
- - - - -
13 changed files:
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/Format.hs
- compiler/GHC/CmmToAsm/Instr.hs
- compiler/GHC/CmmToAsm/PPC.hs
- compiler/GHC/CmmToAsm/PPC/Instr.hs
- compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
- compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
- compiler/GHC/CmmToAsm/Reg/Linear.hs
- compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
- compiler/GHC/CmmToAsm/Reg/Linear/State.hs
- compiler/GHC/CmmToAsm/Reg/Liveness.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/CmmToAsm/X86/RegInfo.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -369,13 +369,12 @@ patchJumpInstr instr patchF
mkSpillInstr
:: HasCallStack
=> NCGConfig
- -> Reg -- register to spill
- -> Format
+ -> RegFormat -- register to spill
-> Int -- current stack delta
-> Int -- spill slot to use
-> [Instr]
-mkSpillInstr config reg fmt delta slot =
+mkSpillInstr config (RegFormat reg fmt) delta slot =
case off - delta of
imm | -256 <= imm && imm <= 255 -> [ mkStrSp imm ]
imm | imm > 0 && imm .&. 0x7 == 0x0 && imm <= 0xfff -> [ mkStrSp imm ]
@@ -396,12 +395,11 @@ mkSpillInstr config reg fmt delta slot =
mkLoadInstr
:: NCGConfig
- -> Reg -- register to load
- -> Format
+ -> RegFormat
-> Int -- current stack delta
-> Int -- spill slot to use
-> [Instr]
-mkLoadInstr config reg fmt delta slot =
+mkLoadInstr config (RegFormat reg fmt) delta slot =
case off - delta of
imm | -256 <= imm && imm <= 255 -> [ mkLdrSp imm ]
imm | imm > 0 && imm .&. 0x7 == 0x0 && imm <= 0xfff -> [ mkLdrSp imm ]
=====================================
compiler/GHC/CmmToAsm/Format.hs
=====================================
@@ -25,6 +25,7 @@ module GHC.CmmToAsm.Format (
formatToWidth,
formatInBytes,
isIntScalarFormat,
+ VirtualRegFormat(..),
RegFormat(..),
takeVirtualRegs,
takeRealRegs,
@@ -120,10 +121,15 @@ intFormat width
"produce code for Format.intFormat " ++ show other
++ "\n\tConsider using the llvm backend with -fllvm"
--- | Check if a format represents a vector
-isVecFormat :: Format -> Bool
-isVecFormat (VecFormat {}) = True
-isVecFormat _ = False
+-- | Check if a format represent an integer value.
+isIntFormat :: Format -> Bool
+isIntFormat format =
+ case format of
+ II8 -> True
+ II16 -> True
+ II32 -> True
+ II64 -> True
+ _ -> False
-- | Get the float format of this width.
floatFormat :: Width -> Format
@@ -131,13 +137,8 @@ floatFormat width
= case width of
W32 -> FF32
W64 -> FF64
-
other -> pprPanic "Format.floatFormat" (ppr other)
--- | Check if a format represent an integer value.
-isIntFormat :: Format -> Bool
-isIntFormat = not . isFloatFormat
-
-- | Check if a format represents a floating point value.
isFloatFormat :: Format -> Bool
isFloatFormat format
@@ -146,14 +147,6 @@ isFloatFormat format
FF64 -> True
_ -> False
-
--- | Convert a Cmm type to a Format.
-cmmTypeFormat :: CmmType -> Format
-cmmTypeFormat ty
- | isFloatType ty = floatFormat (typeWidth ty)
- | isVecType ty = vecFormat ty
- | otherwise = intFormat (typeWidth ty)
-
vecFormat :: CmmType -> Format
vecFormat ty =
let l = vecLength ty
@@ -170,6 +163,20 @@ vecFormat ty =
W64 -> VecFormat l FmtInt64
_ -> pprPanic "Incorrect vector element width" (ppr elemTy)
+-- | Check if a format represents a vector
+isVecFormat :: Format -> Bool
+isVecFormat (VecFormat {}) = True
+isVecFormat _ = False
+
+
+-- | Convert a Cmm type to a Format.
+cmmTypeFormat :: CmmType -> Format
+cmmTypeFormat ty
+ | isFloatType ty = floatFormat (typeWidth ty)
+ | isVecType ty = vecFormat ty
+ | otherwise = intFormat (typeWidth ty)
+
+
-- | Get the Width of a Format.
formatToWidth :: Format -> Width
formatToWidth format
@@ -197,6 +204,12 @@ formatInBytes = widthInBytes . formatToWidth
--------------------------------------------------------------------------------
+data VirtualRegFormat
+ = VirtualRegFormat
+ { virtualRegFormatReg :: {-# UNPACK #-} !VirtualReg
+ , virtualRegFormatFormat :: !Format
+ }
+
-- | A typed register: a register, together with the specific format we
-- are using it at.
data RegFormat
=====================================
compiler/GHC/CmmToAsm/Instr.hs
=====================================
@@ -96,8 +96,7 @@ class Instruction instr where
-- | An instruction to spill a register into a spill slot.
mkSpillInstr
:: NCGConfig
- -> Reg -- ^ the reg to spill
- -> Format
+ -> RegFormat -- ^ the reg to spill
-> Int -- ^ the current stack delta
-> Int -- ^ spill slots to use
-> [instr] -- ^ instructions
@@ -106,11 +105,10 @@ class Instruction instr where
-- | An instruction to reload a register from a spill slot.
mkLoadInstr
:: NCGConfig
- -> Reg -- ^ the reg to reload.
- -> Format
+ -> RegFormat -- ^ the reg to reload.
-> Int -- ^ the current stack delta
-> Int -- ^ the spill slot to use
- -> [instr] -- ^ instructions
+ -> [instr] -- ^ instructions
-- | See if this instruction is telling us the current C stack delta
takeDeltaInstr
@@ -135,8 +133,8 @@ class Instruction instr where
mkRegRegMoveInstr
:: Platform
-> Format
- -> Reg -- ^ source register
- -> Reg -- ^ destination register
+ -> Reg -- ^ source register
+ -> Reg -- ^ destination register
-> instr
-- | Take the source and destination from this reg -> reg move instruction
=====================================
compiler/GHC/CmmToAsm/PPC.hs
=====================================
@@ -48,8 +48,8 @@ instance Instruction PPC.Instr where
jumpDestsOfInstr = PPC.jumpDestsOfInstr
canFallthroughTo = PPC.canFallthroughTo
patchJumpInstr = PPC.patchJumpInstr
- mkSpillInstr cfg reg _ i j = PPC.mkSpillInstr cfg reg i j
- mkLoadInstr cfg reg _ i j = PPC.mkLoadInstr cfg reg i j
+ mkSpillInstr = PPC.mkSpillInstr
+ mkLoadInstr = PPC.mkLoadInstr
takeDeltaInstr = PPC.takeDeltaInstr
isMetaInstr = PPC.isMetaInstr
mkRegRegMoveInstr _ = PPC.mkRegRegMoveInstr
=====================================
compiler/GHC/CmmToAsm/PPC/Instr.hs
=====================================
@@ -550,12 +550,12 @@ patchJumpInstr insn patchF
-- | An instruction to spill a register into a spill slot.
mkSpillInstr
:: NCGConfig
- -> Reg -- register to spill
+ -> RegFormat -- register to spill
-> Int -- current stack delta
-> Int -- spill slot to use
-> [Instr]
-mkSpillInstr config reg delta slot
+mkSpillInstr config (RegFormat reg _fmt) delta slot
= let platform = ncgPlatform config
off = spillSlotToOffset platform slot
arch = platformArch platform
@@ -574,12 +574,12 @@ mkSpillInstr config reg delta slot
mkLoadInstr
:: NCGConfig
- -> Reg -- register to load
+ -> RegFormat -- register to load
-> Int -- current stack delta
-> Int -- spill slot to use
-> [Instr]
-mkLoadInstr config reg delta slot
+mkLoadInstr config (RegFormat reg _fmt) delta slot
= let platform = ncgPlatform config
off = spillSlotToOffset platform slot
arch = platformArch platform
=====================================
compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
=====================================
@@ -243,7 +243,7 @@ spillRead regSlotMap instr (RegFormat reg fmt)
{ stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
return ( instr'
- , ( [LiveInstr (RELOAD slot nReg fmt) Nothing]
+ , ( [LiveInstr (RELOAD slot (RegFormat nReg fmt)) Nothing]
, []) )
| otherwise = panic "RegSpill.spillRead: no slot defined for spilled reg"
@@ -267,7 +267,7 @@ spillWrite regSlotMap instr (RegFormat reg fmt)
return ( instr'
, ( []
- , [LiveInstr (SPILL nReg fmt slot) Nothing]))
+ , [LiveInstr (SPILL (RegFormat nReg fmt) slot) Nothing]))
| otherwise = panic "RegSpill.spillWrite: no slot defined for spilled reg"
@@ -289,8 +289,8 @@ spillModify regSlotMap instr (RegFormat reg fmt)
{ stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
return ( instr'
- , ( [LiveInstr (RELOAD slot nReg fmt) Nothing]
- , [LiveInstr (SPILL nReg fmt slot) Nothing]))
+ , ( [LiveInstr (RELOAD slot (RegFormat nReg fmt)) Nothing]
+ , [LiveInstr (SPILL (RegFormat nReg fmt) slot) Nothing]))
| otherwise = panic "RegSpill.spillModify: no slot defined for spilled reg"
=====================================
compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
=====================================
@@ -161,13 +161,13 @@ cleanForward _ _ _ acc []
-- hopefully the spill will be also be cleaned in the next pass
cleanForward platform blockId assoc acc (li1 : li2 : instrs)
- | LiveInstr (SPILL reg1 _ slot1) _ <- li1
- , LiveInstr (RELOAD slot2 reg2 fmt) _ <- li2
+ | LiveInstr (SPILL reg1 slot1) _ <- li1
+ , LiveInstr (RELOAD slot2 reg2) _ <- li2
, slot1 == slot2
= do
modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
cleanForward platform blockId assoc acc
- $ li1 : LiveInstr (mkRegRegMoveInstr platform fmt reg1 reg2) Nothing
+ $ li1 : LiveInstr (mkRegRegMoveInstr platform (regFormatFormat reg2) (regFormatReg reg1) (regFormatReg reg2)) Nothing
: instrs
cleanForward platform blockId assoc acc (li@(LiveInstr i1 _) : instrs)
@@ -190,8 +190,8 @@ cleanForward platform blockId assoc acc (li@(LiveInstr i1 _) : instrs)
cleanForward platform blockId assoc acc (li : instrs)
-- Update association due to the spill.
- | LiveInstr (SPILL reg _ slot) _ <- li
- = let assoc' = addAssoc (SReg reg) (SSlot slot)
+ | LiveInstr (SPILL reg slot) _ <- li
+ = let assoc' = addAssoc (SReg $ regFormatReg reg) (SSlot slot)
$ delAssoc (SSlot slot)
$ assoc
in cleanForward platform blockId assoc' (li : acc) instrs
@@ -230,7 +230,7 @@ cleanReload
-> LiveInstr instr
-> CleanM (Assoc Store, Maybe (LiveInstr instr))
-cleanReload platform blockId assoc li@(LiveInstr (RELOAD slot reg fmt) _)
+cleanReload platform blockId assoc li@(LiveInstr (RELOAD slot (RegFormat reg fmt)) _)
-- If the reg we're reloading already has the same value as the slot
-- then we can erase the instruction outright.
@@ -248,7 +248,7 @@ cleanReload platform blockId assoc li@(LiveInstr (RELOAD slot reg fmt) _)
$ assoc
return ( assoc'
- , Just $ LiveInstr (mkRegRegMoveInstr platform fmt reg2 reg) Nothing)
+ , Just $ LiveInstr (mkRegRegMoveInstr platform fmt reg2 reg) Nothing )
-- Gotta keep this instr.
| otherwise
@@ -356,12 +356,12 @@ cleanBackward' _ _ _ acc []
cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc (li : instrs)
-- If nothing ever reloads from this slot then we don't need the spill.
- | LiveInstr (SPILL _ _ slot) _ <- li
+ | LiveInstr (SPILL _ slot) _ <- li
, Nothing <- lookupUFM reloadedBy (SSlot slot)
= do modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
cleanBackward liveSlotsOnEntry noReloads acc instrs
- | LiveInstr (SPILL _ _ slot) _ <- li
+ | LiveInstr (SPILL _ slot) _ <- li
= if elementOfUniqSet slot noReloads
-- We can erase this spill because the slot won't be read until
@@ -376,7 +376,7 @@ cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc (li : instrs)
cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
-- if we reload from a slot then it's no longer unused
- | LiveInstr (RELOAD slot _ _) _ <- li
+ | LiveInstr (RELOAD slot _) _ <- li
, noReloads' <- delOneFromUniqSet noReloads slot
= cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
=====================================
compiler/GHC/CmmToAsm/Reg/Linear.hs
=====================================
@@ -135,8 +135,9 @@ import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Platform
+import Data.Containers.ListUtils
import Data.Maybe
-import Data.List (partition, nub)
+import Data.List (partition)
import Control.Monad
-- -----------------------------------------------------------------------------
@@ -501,13 +502,14 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying = do
platform <- getPlatform
case regUsageOfInstr platform instr of { RU read written ->
do
- let real_written = [ rr | RegFormat { regFormatReg = RegReal rr } <- written ] :: [RealReg]
- let virt_written = [ vr | RegFormat { regFormatReg = RegVirtual vr } <- written ]
+ let real_written = [ rr | RegFormat {regFormatReg = RegReal rr} <- written ]
+ let virt_written = [ VirtualRegFormat vr fmt | RegFormat (RegVirtual vr) fmt <- written ]
-- we don't need to do anything with real registers that are
-- only read by this instr. (the list is typically ~2 elements,
-- so using nub isn't a problem).
- let virt_read = nub [ vr | RegFormat { regFormatReg = RegVirtual vr }<- read ] :: [VirtualReg]
+ let virt_read :: [VirtualRegFormat]
+ virt_read = nubOrdOn virtualRegFormatReg [ VirtualRegFormat vr fmt | RegFormat (RegVirtual vr) fmt <- read ]
-- do
-- let real_read = nub [ rr | (RegReal rr) <- read]
@@ -567,9 +569,9 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying = do
= toRegMap $ -- Cast key from VirtualReg to Reg
-- See Note [UniqFM and the register allocator]
listToUFM
- [ (t, RegReal r)
- | (t, r) <- zip virt_read r_allocd
- ++ zip virt_written w_allocd ]
+ [ (virtualRegFormatReg vr, RegReal rr)
+ | (vr, rr) <- zip virt_read r_allocd
+ ++ zip virt_written w_allocd ]
patched_instr :: instr
patched_instr
@@ -721,7 +723,7 @@ saveClobberedTemps clobbered dying
-- (2) no free registers: spill the value
[] -> do
- (spill, slot) <- spillR (RegReal reg) fmt temp
+ (spill, slot) <- spillR (RegFormat (RegReal reg) fmt) temp
-- record why this reg was spilled for profiling
recordSpill (SpillClobber temp)
@@ -800,21 +802,21 @@ data SpillLoc = ReadMem StackSlot -- reading from register only in memory
allocateRegsAndSpill
:: forall freeRegs instr. (FR freeRegs, Instruction instr)
- => Bool -- True <=> reading (load up spilled regs)
- -> [VirtualReg] -- don't push these out
- -> [instr] -- spill insns
- -> [RealReg] -- real registers allocated (accum.)
- -> [VirtualReg] -- temps to allocate
+ => Bool -- True <=> reading (load up spilled regs)
+ -> [VirtualRegFormat] -- don't push these out
+ -> [instr] -- spill insns
+ -> [RealReg] -- real registers allocated (accum.)
+ -> [VirtualRegFormat] -- temps to allocate
-> RegM freeRegs ( [instr] , [RealReg])
allocateRegsAndSpill _ _ spills alloc []
= return (spills, reverse alloc)
-allocateRegsAndSpill reading keep spills alloc (r:rs)
+allocateRegsAndSpill reading keep spills alloc (VirtualRegFormat r fmt:rs)
= do assig <- toVRegMap <$> getAssigR
-- pprTraceM "allocateRegsAndSpill:assig" (ppr (r:rs) $$ ppr assig)
-- See Note [UniqFM and the register allocator]
- let doSpill = allocRegsAndSpill_spill reading keep spills alloc r rs assig
+ let doSpill = allocRegsAndSpill_spill reading keep spills alloc (VirtualRegFormat r fmt) rs assig
case lookupUFM assig r of
-- case (1a): already in a register
Just (InReg my_reg) ->
@@ -859,29 +861,19 @@ findPrefRealReg vreg = do
-- convenient and it maintains the recursive structure of the allocator. -- EZY
allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr)
=> Bool
- -> [VirtualReg]
+ -> [VirtualRegFormat]
-> [instr]
-> [RealReg]
- -> VirtualReg
- -> [VirtualReg]
+ -> VirtualRegFormat
+ -> [VirtualRegFormat]
-> UniqFM VirtualReg Loc
-> SpillLoc
-> RegM freeRegs ([instr], [RealReg])
-allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
+allocRegsAndSpill_spill reading keep spills alloc (VirtualRegFormat r fmt) rs assig spill_loc
= do platform <- getPlatform
freeRegs <- getFreeRegsR
let regclass = classOfVirtualReg r
freeRegs_thisClass = frGetFreeRegs platform regclass freeRegs :: [RealReg]
- vr_fmt = case r of
- VirtualRegV128 {} -> VecFormat 2 FmtDouble
- -- It doesn't really matter whether we use e.g. v2f64 or v4f32
- -- or v4i32 etc here. This is perhaps a sign that 'Format'
- -- is not the right type to use here, but that is a battle
- -- for another day.
- VirtualRegD {} -> FF64
- VirtualRegI {} -> II64
- VirtualRegHi {} -> II64
-
-- Can we put the variable into a register it already was?
pref_reg <- findPrefRealReg r
@@ -895,10 +887,10 @@ allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
= reg
| otherwise
= first_free
- spills' <- loadTemp r vr_fmt spill_loc final_reg spills
+ spills' <- loadTemp (VirtualRegFormat r fmt) spill_loc final_reg spills
setAssigR $ toRegMap
- $ (addToUFM assig r $! newLocation spill_loc $ RealRegUsage final_reg vr_fmt)
+ $ (addToUFM assig r $! newLocation spill_loc $ RealRegUsage final_reg fmt)
setFreeRegsR $ frAllocateReg platform final_reg freeRegs
allocateRegsAndSpill reading keep spills' (final_reg : alloc) rs
@@ -911,7 +903,7 @@ allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
inRegOrBoth _ = False
let candidates' :: UniqFM VirtualReg Loc
candidates' =
- flip delListFromUFM keep $
+ flip delListFromUFM (fmap virtualRegFormatReg keep) $
filterUFM inRegOrBoth $
assig
-- This is non-deterministic but we do not
@@ -941,7 +933,7 @@ allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
-- we have a temporary that is in both register and mem,
-- just free up its register for use.
| (temp, myRegUse@(RealRegUsage my_reg fmt), slot) : _ <- candidates_inBoth
- = do spills' <- loadTemp r fmt spill_loc my_reg spills
+ = do spills' <- loadTemp (VirtualRegFormat r fmt) spill_loc my_reg spills
let assig1 = addToUFM_Directly assig temp (InMem slot)
let assig2 = addToUFM assig1 r $! newLocation spill_loc myRegUse
@@ -953,7 +945,7 @@ allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
| (temp_to_push_out, RealRegUsage my_reg fmt) : _
<- candidates_inReg
= do
- (spill_store, slot) <- spillR (RegReal my_reg) fmt temp_to_push_out
+ (spill_store, slot) <- spillR (RegFormat (RegReal my_reg) fmt) temp_to_push_out
-- record that this temp was spilled
recordSpill (SpillAlloc temp_to_push_out)
@@ -964,7 +956,7 @@ allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
setAssigR $ toRegMap assig2
-- if need be, load up a spilled temp into the reg we've just freed up.
- spills' <- loadTemp r fmt spill_loc my_reg spills
+ spills' <- loadTemp (VirtualRegFormat r fmt) spill_loc my_reg spills
allocateRegsAndSpill reading keep
(spill_store ++ spills')
@@ -994,18 +986,17 @@ newLocation _ my_reg = InReg my_reg
-- | Load up a spilled temporary if we need to (read from memory).
loadTemp
:: (Instruction instr)
- => VirtualReg -- the temp being loaded
- -> Format
+ => VirtualRegFormat -- the temp being loaded
-> SpillLoc -- the current location of this temp
-> RealReg -- the hreg to load the temp into
-> [instr]
-> RegM freeRegs [instr]
-loadTemp vreg fmt (ReadMem slot) hreg spills
+loadTemp (VirtualRegFormat vreg fmt) (ReadMem slot) hreg spills
= do
- insn <- loadR (RegReal hreg) fmt slot
+ insn <- loadR (RegFormat (RegReal hreg) fmt) slot
recordSpill (SpillLoad $ getUnique vreg)
return $ {- mkComment (text "spill load") : -} insn ++ spills
-loadTemp _ _ _ _ spills =
+loadTemp _ _ _ spills =
return spills
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
=====================================
@@ -333,10 +333,10 @@ handleComponent delta instr
= do
-- spill the source into its slot
(instrSpill, slot)
- <- spillR (RegReal sreg) scls vreg
+ <- spillR (RegFormat (RegReal sreg) scls) vreg
-- reload into destination reg
- instrLoad <- loadR (RegReal dreg) dcls slot
+ instrLoad <- loadR (RegFormat (RegReal dreg) dcls) slot
remainingFixUps <- mapM (handleComponent delta instr)
(stronglyConnCompFromEdgedVerticesOrdR rest)
@@ -369,10 +369,10 @@ makeMove delta vreg src dst
return $ [mkRegRegMoveInstr platform fmt (RegReal s) (RegReal d)]
(InMem s, InReg (RealRegUsage d cls)) ->
do recordSpill (SpillJoinRM vreg)
- return $ mkLoadInstr config (RegReal d) cls delta s
+ return $ mkLoadInstr config (RegFormat (RegReal d) cls) delta s
(InReg (RealRegUsage s cls), InMem d) ->
do recordSpill (SpillJoinRM vreg)
- return $ mkSpillInstr config (RegReal s) cls delta d
+ return $ mkSpillInstr config (RegFormat (RegReal s) cls) delta d
_ ->
-- we don't handle memory to memory moves.
-- they shouldn't happen because we don't share
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/State.hs
=====================================
@@ -44,7 +44,6 @@ import GHC.CmmToAsm.Reg.Linear.Base
import GHC.CmmToAsm.Reg.Liveness
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.Config
-import GHC.Platform.Reg
import GHC.Cmm.BlockId
import GHC.Platform
@@ -122,20 +121,20 @@ makeRAStats state
spillR :: Instruction instr
- => Reg -> Format -> Unique -> RegM freeRegs ([instr], Int)
+ => RegFormat -> Unique -> RegM freeRegs ([instr], Int)
-spillR reg fmt temp = mkRegM $ \s ->
- let (stack1,slots) = getStackSlotFor (ra_stack s) fmt temp
- instr = mkSpillInstr (ra_config s) reg fmt (ra_delta s) slots
+spillR reg temp = mkRegM $ \s ->
+ let (stack1,slots) = getStackSlotFor (ra_stack s) (regFormatFormat reg) temp
+ instr = mkSpillInstr (ra_config s) reg (ra_delta s) slots
in
RA_Result s{ra_stack=stack1} (instr,slots)
loadR :: Instruction instr
- => Reg -> Format -> Int -> RegM freeRegs [instr]
+ => RegFormat -> Int -> RegM freeRegs [instr]
-loadR reg fmt slot = mkRegM $ \s ->
- RA_Result s (mkLoadInstr (ra_config s) reg fmt (ra_delta s) slot)
+loadR reg slot = mkRegM $ \s ->
+ RA_Result s (mkLoadInstr (ra_config s) reg (ra_delta s) slot)
getFreeRegsR :: RegM freeRegs freeRegs
getFreeRegsR = mkRegM $ \ s at RA_State{ra_freeregs = freeregs} ->
=====================================
compiler/GHC/CmmToAsm/Reg/Liveness.hs
=====================================
@@ -97,29 +97,32 @@ type LiveCmmDecl statics instr
-- so we'll keep those here.
data InstrSR instr
-- | A real machine instruction
- = Instr instr
+ = Instr !instr
-- | spill this reg to a stack slot
- | SPILL Reg Format Int
+ | SPILL !RegFormat !Int
-- | reload this reg from a stack slot
- | RELOAD Int Reg Format
+ | RELOAD !Int !RegFormat
deriving (Functor)
instance Instruction instr => Instruction (InstrSR instr) where
regUsageOfInstr platform i
= case i of
- Instr instr -> regUsageOfInstr platform instr
- SPILL reg fmt _ -> RU [RegFormat reg fmt] []
- RELOAD _ reg fmt -> RU [] [RegFormat reg fmt]
+ Instr instr -> regUsageOfInstr platform instr
+ SPILL reg _ -> RU [reg] []
+ RELOAD _ reg -> RU [] [reg]
patchRegsOfInstr i f
= case i of
Instr instr -> Instr (patchRegsOfInstr instr f)
- SPILL reg cls slot -> SPILL (f reg) cls slot
- RELOAD slot reg cls -> RELOAD slot (f reg) cls
+ SPILL reg slot -> SPILL (updReg f reg) slot
+ RELOAD slot reg -> RELOAD slot (updReg f reg)
+ where
+ updReg g (RegFormat reg fmt) = RegFormat (g reg) fmt
+ isJumpishInstr :: Instruction instr => InstrSR instr -> Bool
isJumpishInstr i
= case i of
Instr instr -> isJumpishInstr instr
@@ -214,7 +217,7 @@ instance Outputable instr
ppr (Instr realInstr)
= ppr realInstr
- ppr (SPILL reg _cls slot)
+ ppr (SPILL (RegFormat reg _fmt) slot)
= hcat [
text "\tSPILL",
char ' ',
@@ -222,7 +225,7 @@ instance Outputable instr
comma,
text "SLOT" <> parens (int slot)]
- ppr (RELOAD slot reg _cls)
+ ppr (RELOAD slot (RegFormat reg _fmt))
= hcat [
text "\tRELOAD",
char ' ',
@@ -458,12 +461,12 @@ slurpReloadCoalesce live
slurpLI slotMap li
-- remember what reg was stored into the slot
- | LiveInstr (SPILL reg _cls slot) _ <- li
- , slotMap' <- addToUFM slotMap slot reg
+ | LiveInstr (SPILL (RegFormat reg _fmt) slot) _ <- li
+ , slotMap' <- addToUFM slotMap slot reg
= return (slotMap', Nothing)
-- add an edge between the this reg and the last one stored into the slot
- | LiveInstr (RELOAD slot reg _cls) _ <- li
+ | LiveInstr (RELOAD slot (RegFormat reg _fmt)) _ <- li
= case lookupUFM slotMap slot of
Just reg2
| reg /= reg2 -> return (slotMap, Just (reg, reg2))
@@ -572,13 +575,13 @@ stripLiveBlock config (BasicBlock i lis)
-- The SPILL/RELOAD cases do not appear to be exercised by our codegens
--
- spillNat acc (LiveInstr (SPILL reg cls slot) _ : instrs)
+ spillNat acc (LiveInstr (SPILL reg slot) _ : instrs)
= do delta <- get
- spillNat (mkSpillInstr config reg cls delta slot ++ acc) instrs
+ spillNat (mkSpillInstr config reg delta slot ++ acc) instrs
- spillNat acc (LiveInstr (RELOAD slot reg cls) _ : instrs)
+ spillNat acc (LiveInstr (RELOAD slot reg) _ : instrs)
= do delta <- get
- spillNat (mkLoadInstr config reg cls delta slot ++ acc) instrs
+ spillNat (mkLoadInstr config reg delta slot ++ acc) instrs
spillNat acc (LiveInstr (Instr instr) _ : instrs)
| Just i <- takeDeltaInstr instr
=====================================
compiler/GHC/CmmToAsm/X86/Instr.hs
=====================================
@@ -859,13 +859,12 @@ patchJumpInstr insn patchF
-- | Make a spill instruction.
mkSpillInstr
:: NCGConfig
- -> Reg -- register to spill
- -> Format
- -> Int -- current stack delta
- -> Int -- spill slot to use
+ -> RegFormat -- register to spill
+ -> Int -- current stack delta
+ -> Int -- spill slot to use
-> [Instr]
-mkSpillInstr config reg fmt delta slot
+mkSpillInstr config (RegFormat reg fmt) delta slot
= let off = spillSlotToOffset platform slot - delta
in case fmt of
VecFormat {}
@@ -881,13 +880,12 @@ mkSpillInstr config reg fmt delta slot
-- | Make a spill reload instruction.
mkLoadInstr
:: NCGConfig
- -> Reg -- register to load
- -> Format
+ -> RegFormat -- register to load
-> Int -- current stack delta
-> Int -- spill slot to use
-> [Instr]
-mkLoadInstr config reg fmt delta slot
+mkLoadInstr config (RegFormat reg fmt) delta slot
= let off = spillSlotToOffset platform slot - delta
in case fmt of
VecFormat {}
@@ -955,17 +953,19 @@ mkRegRegMoveInstr
-> Reg
-> Reg
-> Instr
-mkRegRegMoveInstr _platform fmt@(VecFormat _ s) src dst
- | isIntScalarFormat s
- = if widthInBytes (formatToWidth fmt) <= 128
- then MOVDQU fmt (OpReg src) (OpReg dst)
- else VMOVDQU fmt (OpReg src) (OpReg dst)
- | otherwise
- = if widthInBytes (formatToWidth fmt) <= 128
- then MOVU fmt (OpReg src) (OpReg dst)
- else VMOVU fmt (OpReg src) (OpReg dst)
-mkRegRegMoveInstr platform fmt src dst
- = MOV (scalarMoveFormat platform fmt) (OpReg src) (OpReg dst)
+mkRegRegMoveInstr platform fmt src dst =
+ case fmt of
+ VecFormat _ s
+ | isIntScalarFormat s ->
+ if widthInBytes (formatToWidth fmt) <= 128
+ then MOVDQU fmt (OpReg src) (OpReg dst)
+ else VMOVDQU fmt (OpReg src) (OpReg dst)
+ | otherwise ->
+ if widthInBytes (formatToWidth fmt) <= 128
+ then MOVU fmt (OpReg src) (OpReg dst)
+ else VMOVU fmt (OpReg src) (OpReg dst)
+ _ ->
+ MOV (scalarMoveFormat platform fmt) (OpReg src) (OpReg dst)
scalarMoveFormat :: Platform -> Format -> Format
scalarMoveFormat platform fmt
@@ -973,10 +973,8 @@ scalarMoveFormat platform fmt
= FF64
| II64 <- fmt
= II64
- | PW4 <- platformWordSize platform
- = II32
| otherwise
- = II64
+ = archWordFormat (target32Bit platform)
-- | Check whether an instruction represents a reg-reg move.
-- The register allocator attempts to eliminate reg->reg moves whenever it can,
=====================================
compiler/GHC/CmmToAsm/X86/RegInfo.hs
=====================================
@@ -24,10 +24,7 @@ mkVirtualReg :: Unique -> Format -> VirtualReg
mkVirtualReg u format
= case format of
FF32 -> VirtualRegD u
- -- for scalar F32, we use the same xmm as F64!
- -- this is a hack that needs some improvement.
- -- For now we map both to being allocated as "Double" Registers
- -- on X86/X86_64
+ -- On X86, we pass 32-bit floats in the same registers as 64-bit floats.
FF64 -> VirtualRegD u
-- SIMD NCG TODO: add support for 256 and 512-wide vectors.
VecFormat {} -> VirtualRegV128 u
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a012d5e443058641c7b579ea1799d1f7e51617da
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a012d5e443058641c7b579ea1799d1f7e51617da
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/20240620/cf62aa05/attachment-0001.html>
More information about the ghc-commits
mailing list