Simon Jakobi pushed to branch wip/sjakobi/T26665-fr at Glasgow Haskell Compiler / GHC
Commits:
3251755c by Simon Jakobi at 2026-06-25T23:36:47+02:00
Reg.Linear: drop Platform argument from most FR (FreeRegs) methods
The FR class has one instance per CPU architecture, so any
architecture-constant information its methods derived from the Platform
argument can instead be baked into the instance. This removes the now
needless Platform argument from frAllocateReg, frGetFreeRegs and
frReleaseReg.
frInitFreeRegs keeps its Platform argument: the initial allocatable set is
genuinely platform-dependent, see Note [Aarch64 Register x18 at Darwin and
Windows].
Fixes #26665
Co-Authored-By: Claude Opus 4.8
- - - - -
7 changed files:
- compiler/GHC/CmmToAsm/Reg/Linear.hs
- compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs
- compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
- compiler/GHC/CmmToAsm/Reg/Linear/X86.hs
- compiler/GHC/CmmToAsm/Reg/Linear/X86_64.hs
- compiler/GHC/CmmToAsm/X86/RegInfo.hs
- compiler/GHC/CmmToAsm/X86/Regs.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/Reg/Linear.hs
=====================================
@@ -367,7 +367,7 @@ initBlock id block_live
Nothing ->
setFreeRegsR (frInitFreeRegs platform)
Just live ->
- setFreeRegsR $ foldl' (flip $ frAllocateReg platform) (frInitFreeRegs platform)
+ setFreeRegsR $ foldl' (flip frAllocateReg) (frInitFreeRegs platform)
(nonDetEltsUniqSet $ takeRealRegs $ getRegs live)
-- See Note [Unique Determinism and code generation]
setAssigR emptyRegMap
@@ -638,20 +638,19 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying = do
releaseRegs :: FR freeRegs => [Reg] -> RegM freeRegs ()
releaseRegs regs = do
- platform <- getPlatform
assig <- getAssigR
free <- getFreeRegsR
let loop assig !free [] = do setAssigR assig; setFreeRegsR free; return ()
- loop assig !free (RegReal rr : rs) = loop assig (frReleaseReg platform rr free) rs
+ loop assig !free (RegReal rr : rs) = loop assig (frReleaseReg rr free) rs
loop assig !free (r:rs) =
case lookupUFM assig r of
Just (Loc (InBoth real _) _) ->
loop (delFromUFM assig r)
- (frReleaseReg platform real free) rs
+ (frReleaseReg real free) rs
Just (Loc (InReg real) _) ->
loop (delFromUFM assig r)
- (frReleaseReg platform real free) rs
+ (frReleaseReg real free) rs
_ ->
loop (delFromUFM assig r) free rs
loop assig free regs
@@ -716,7 +715,7 @@ saveClobberedTemps clobbered dying
freeRegs <- getFreeRegsR
let regclass = targetClassOfRealReg platform reg
- freeRegs_thisClass = frGetFreeRegs platform regclass freeRegs
+ freeRegs_thisClass = frGetFreeRegs regclass freeRegs
case filter (`notElem` clobbered) freeRegs_thisClass of
@@ -724,7 +723,7 @@ saveClobberedTemps clobbered dying
-- clobbered by this instruction; use it to save the
-- clobbered value.
(my_reg : _) -> do
- setFreeRegsR (frAllocateReg platform my_reg freeRegs)
+ setFreeRegsR (frAllocateReg my_reg freeRegs)
let new_assign = addToUFM_Directly assig temp (Loc (InReg my_reg) fmt)
let instr = mkRegRegMoveInstr config fmt
@@ -763,13 +762,13 @@ clobberRegs clobbered
Unified -> Unified.allRegClasses
Separate -> Separate.allRegClasses
NoVectors -> NoVectors.allRegClasses
- allFreeRegs = foldMap (\ rc -> frGetFreeRegs platform rc freeregs) allRegClasses
+ allFreeRegs = foldMap (\ rc -> frGetFreeRegs rc freeregs) allRegClasses
let extra_clobbered = [ r | r <- clobbered, r `elem` allFreeRegs ]
- setFreeRegsR $! foldl' (flip $ frAllocateReg platform) freeregs extra_clobbered
+ setFreeRegsR $! foldl' (flip frAllocateReg) freeregs extra_clobbered
- -- setFreeRegsR $! foldl' (flip $ frAllocateReg platform) freeregs clobbered
+ -- setFreeRegsR $! foldl' (flip frAllocateReg) freeregs clobbered
assig <- getAssigR
setAssigR $! clobber assig (nonDetUFMToList assig)
@@ -896,7 +895,7 @@ allocRegsAndSpill_spill reading keep spills alloc r@(VirtualRegWithFormat vr vrF
= do platform <- getPlatform
freeRegs <- getFreeRegsR
let regclass = classOfVirtualReg (platformArch platform) vr
- freeRegs_thisClass = frGetFreeRegs platform regclass freeRegs :: [RealReg]
+ freeRegs_thisClass = frGetFreeRegs regclass freeRegs :: [RealReg]
-- Can we put the variable into a register it already was?
pref_reg <- findPrefRealReg vr
@@ -915,7 +914,7 @@ allocRegsAndSpill_spill reading keep spills alloc r@(VirtualRegWithFormat vr vrF
setAssigR $ toRegMap
$ (addToUFM assig vr $! newLocation spill_loc $ RealRegUsage final_reg vrFmt)
- setFreeRegsR $ frAllocateReg platform final_reg freeRegs
+ setFreeRegsR $ frAllocateReg final_reg freeRegs
allocateRegsAndSpill reading keep spills' (final_reg : alloc) rs
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs
=====================================
@@ -43,49 +43,51 @@ import qualified GHC.CmmToAsm.RV64.Instr as RV64.Instr
import qualified GHC.CmmToAsm.LA64.Instr as LA64.Instr
class Show freeRegs => FR freeRegs where
- frAllocateReg :: Platform -> RealReg -> freeRegs -> freeRegs
- frGetFreeRegs :: Platform -> RegClass -> freeRegs -> [RealReg]
+ frAllocateReg :: RealReg -> freeRegs -> freeRegs
+ frGetFreeRegs :: RegClass -> freeRegs -> [RealReg]
+ -- | The initial allocatable set is platform-dependent. See Note
+ -- [Aarch64 Register x18 at Darwin and Windows].
frInitFreeRegs :: Platform -> freeRegs
- frReleaseReg :: Platform -> RealReg -> freeRegs -> freeRegs
+ frReleaseReg :: RealReg -> freeRegs -> freeRegs
instance FR X86.FreeRegs where
- frAllocateReg = \_ -> X86.allocateReg
+ frAllocateReg = X86.allocateReg
frGetFreeRegs = X86.getFreeRegs
frInitFreeRegs = X86.initFreeRegs
- frReleaseReg = \_ -> X86.releaseReg
+ frReleaseReg = X86.releaseReg
instance FR X86_64.FreeRegs where
- frAllocateReg = \_ -> X86_64.allocateReg
+ frAllocateReg = X86_64.allocateReg
frGetFreeRegs = X86_64.getFreeRegs
frInitFreeRegs = X86_64.initFreeRegs
- frReleaseReg = \_ -> X86_64.releaseReg
+ frReleaseReg = X86_64.releaseReg
instance FR PPC.FreeRegs where
- frAllocateReg = \_ -> PPC.allocateReg
- frGetFreeRegs = \_ -> PPC.getFreeRegs
+ frAllocateReg = PPC.allocateReg
+ frGetFreeRegs = PPC.getFreeRegs
frInitFreeRegs = PPC.initFreeRegs
- frReleaseReg = \_ -> PPC.releaseReg
+ frReleaseReg = PPC.releaseReg
instance FR AArch64.FreeRegs where
- frAllocateReg = \_ -> AArch64.allocateReg
- frGetFreeRegs = \_ -> AArch64.getFreeRegs
+ frAllocateReg = AArch64.allocateReg
+ frGetFreeRegs = AArch64.getFreeRegs
frInitFreeRegs = AArch64.initFreeRegs
- frReleaseReg = \_ -> AArch64.releaseReg
+ frReleaseReg = AArch64.releaseReg
instance FR RV64.FreeRegs where
- frAllocateReg = const RV64.allocateReg
- frGetFreeRegs = const RV64.getFreeRegs
+ frAllocateReg = RV64.allocateReg
+ frGetFreeRegs = RV64.getFreeRegs
frInitFreeRegs = RV64.initFreeRegs
- frReleaseReg = const RV64.releaseReg
+ frReleaseReg = RV64.releaseReg
instance FR LA64.FreeRegs where
- frAllocateReg = \_ -> LA64.allocateReg
- frGetFreeRegs = \_ -> LA64.getFreeRegs
+ frAllocateReg = LA64.allocateReg
+ frGetFreeRegs = LA64.getFreeRegs
frInitFreeRegs = LA64.initFreeRegs
- frReleaseReg = \_ -> LA64.releaseReg
+ frReleaseReg = LA64.releaseReg
allFreeRegs :: FR freeRegs => Platform -> freeRegs -> [RealReg]
-allFreeRegs plat fr = foldMap (\rcls -> frGetFreeRegs plat rcls fr) allRegClasses
+allFreeRegs plat fr = foldMap (\rcls -> frGetFreeRegs rcls fr) allRegClasses
where
allRegClasses =
case registerArch (platformArch plat) of
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
=====================================
@@ -15,7 +15,6 @@ import GHC.CmmToAsm.Reg.Linear.Base
import GHC.CmmToAsm.Reg.Linear.FreeRegs
import GHC.CmmToAsm.Reg.Liveness
import GHC.CmmToAsm.Instr
-import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Types
import GHC.Platform.Reg
@@ -132,12 +131,9 @@ joinToTargets_first block_live new_blocks block_id instr dest dests
block_assig src_assig
to_free
- = do config <- getConfig
- let platform = ncgPlatform config
-
- -- free up the regs that are not live on entry to this block.
+ = do -- free up the regs that are not live on entry to this block.
freeregs <- getFreeRegsR
- let freeregs' = foldl' (flip $ frReleaseReg platform) freeregs to_free
+ let freeregs' = foldl' (flip frReleaseReg) freeregs to_free
-- remember the current assignment on entry to this block.
setBlockAssigR (updateBlockAssignment dest (freeregs', src_assig) block_assig)
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/X86.hs
=====================================
@@ -25,17 +25,17 @@ initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform
= foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)
-getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
-getFreeRegs platform cls (FreeRegs f) =
+getFreeRegs :: RegClass -> FreeRegs -> [RealReg] -- lazily
+getFreeRegs cls (FreeRegs f) =
case cls of
RcInteger ->
[ RealRegSingle i
- | i <- intregnos platform
+ | i <- intregnos PW4
, testBit f i
]
RcFloatOrVector ->
[ RealRegSingle i
- | i <- xmmregnos platform
+ | i <- xmmregnos PW4
, testBit f i
]
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/X86_64.hs
=====================================
@@ -25,17 +25,17 @@ initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform
= foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)
-getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
-getFreeRegs platform cls (FreeRegs f) =
+getFreeRegs :: RegClass -> FreeRegs -> [RealReg] -- lazily
+getFreeRegs cls (FreeRegs f) =
case cls of
RcInteger ->
[ RealRegSingle i
- | i <- intregnos platform
+ | i <- intregnos PW8
, testBit f i
]
RcFloatOrVector ->
[ RealRegSingle i
- | i <- xmmregnos platform
+ | i <- xmmregnos PW8
, testBit f i
]
=====================================
compiler/GHC/CmmToAsm/X86/RegInfo.hs
=====================================
@@ -41,9 +41,11 @@ regColors platform = listToUFM (normalRegColors platform)
normalRegColors :: Platform -> [(RealReg,String)]
normalRegColors platform =
- zip (map realRegSingle [0..lastint platform]) colors
- ++ zip (map realRegSingle [firstxmm..lastxmm platform]) greys
+ zip (map realRegSingle [0..lastint wordSize]) colors
+ ++ zip (map realRegSingle [firstxmm..lastxmm wordSize]) greys
where
+ wordSize = platformWordSize platform
+
-- 16 colors - enough for amd64 gp regs
colors = ["#800000","#ff0000","#808000","#ffff00","#008000"
,"#00ff00","#008080","#00ffff","#000080","#0000ff"
=====================================
compiler/GHC/CmmToAsm/X86/Regs.hs
=====================================
@@ -194,27 +194,23 @@ spRel platform n
firstxmm :: RegNo
firstxmm = 16
--- on 32bit platformOSs, only the first 8 XMM/YMM/ZMM registers are available
-lastxmm :: Platform -> RegNo
-lastxmm platform
- | target32Bit platform = firstxmm + 7 -- xmm0 - xmmm7
- | otherwise = firstxmm + 15 -- xmm0 -xmm15
+-- on 32bit platforms, only the first 8 XMM/YMM/ZMM registers are available
+lastxmm :: PlatformWordSize -> RegNo
+lastxmm PW4 = firstxmm + 7 -- xmm0 - xmm7
+lastxmm PW8 = firstxmm + 15 -- xmm0 - xmm15
-lastint :: Platform -> RegNo
-lastint platform
- | target32Bit platform = 7 -- not %r8..%r15
- | otherwise = 15
+lastint :: PlatformWordSize -> RegNo
+lastint PW4 = 7 -- not %r8..%r15
+lastint PW8 = 15
-intregnos :: Platform -> [RegNo]
-intregnos platform = [0 .. lastint platform]
+intregnos :: PlatformWordSize -> [RegNo]
+intregnos wordSize = [0 .. lastint wordSize]
-
-
-xmmregnos :: Platform -> [RegNo]
-xmmregnos platform = [firstxmm .. lastxmm platform]
+xmmregnos :: PlatformWordSize -> [RegNo]
+xmmregnos wordSize = [firstxmm .. lastxmm wordSize]
floatregnos :: Platform -> [RegNo]
-floatregnos platform = xmmregnos platform
+floatregnos platform = xmmregnos (platformWordSize platform)
-- argRegs is the set of regs which are read for an n-argument call to C.
-- For archs which pass all args on the stack (x86), is empty.
@@ -224,7 +220,7 @@ argRegs _ = panic "MachRegs.argRegs(x86): should not be used!"
-- | The complete set of machine registers.
allMachRegNos :: Platform -> [RegNo]
-allMachRegNos platform = intregnos platform ++ floatregnos platform
+allMachRegNos platform = intregnos (platformWordSize platform) ++ floatregnos platform
-- | Take the class of a register.
{-# INLINE classOfRealReg #-}
@@ -236,9 +232,11 @@ classOfRealReg :: Platform -> RealReg -> RegClass
classOfRealReg platform reg
= case reg of
RealRegSingle i
- | i <= lastint platform -> RcInteger
- | i <= lastxmm platform -> RcFloatOrVector
+ | i <= lastint wordSize -> RcInteger
+ | i <= lastxmm wordSize -> RcFloatOrVector
| otherwise -> panic "X86.Reg.classOfRealReg registerSingle too high"
+ where
+ wordSize = platformWordSize platform
-- machine specific ------------------------------------------------------------
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3251755c4d33b3c8630619820975fc04...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3251755c4d33b3c8630619820975fc04...
You're receiving this email because of your account on gitlab.haskell.org.
