[Git][ghc/ghc][wip/sjakobi/T26665-fr] Reg.Linear: drop Platform from most FR (FreeRegs) methods

17 Jun 2026

Simon Jakobi pushed to branch wip/sjakobi/T26665-fr at Glasgow Haskell Compiler / GHC


Commits:
6911fbea by Simon Jakobi at 2026-06-17T15:19:53+02:00
Reg.Linear: drop Platform from most FR (FreeRegs) methods

The Platform argument of the FR class methods is redundant for all but
frInitFreeRegs: each architecture has its own instance, so the arch is
already fixed by instance selection.

frAllocateReg and frReleaseReg ignored Platform in every instance, and
frGetFreeRegs used it only in the X86/X86_64 instances to choose the
integer/xmm register ranges. Those ranges depend on the platform only
through its word size, so parameterise lastint/lastxmm/intregnos/xmmregnos
in GHC.CmmToAsm.X86.Regs on PlatformWordSize and have the X86/X86_64
getFreeRegs pass a fixed PW4/PW8 -- keeping a single source of truth and
leaving getFreeRegs Platform-free.

frInitFreeRegs keeps its Platform argument: AArch64 reserves x18 on
Darwin/Windows, an OS distinction within a single instance that instance
selection cannot resolve.

Fixes #26665

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>

- - - - -


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] in GHC.Platform.Regs.
     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/6911fbea532bac9a399113a93d26562e...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6911fbea532bac9a399113a93d26562e...
You're receiving this email because of your account on gitlab.haskell.org.

    

Simon Jakobi (＠sjakobi2)

tags

participants (1)