[Git][ghc/ghc][wip/ncg-simd] WIP: more SIMD debugging

sheaf (@sheaf) gitlab at gitlab.haskell.org
Thu Jun 20 16:28:06 UTC 2024



sheaf pushed to branch wip/ncg-simd at Glasgow Haskell Compiler / GHC


Commits:
9c1487b5 by sheaf at 2024-06-20T18:27:54+02:00
WIP: more SIMD debugging

- - - - -


6 changed files:

- compiler/GHC/CmmToAsm/Format.hs
- compiler/GHC/CmmToAsm/Reg/Graph.hs
- compiler/GHC/CmmToAsm/Reg/Linear.hs
- compiler/GHC/CmmToAsm/Reg/Linear/Base.hs
- compiler/GHC/CmmToAsm/Reg/Liveness.hs
- compiler/GHC/CmmToAsm/Reg/Target.hs


Changes:

=====================================
compiler/GHC/CmmToAsm/Format.hs
=====================================
@@ -29,7 +29,6 @@ module GHC.CmmToAsm.Format (
     RegFormat(..),
     takeVirtualRegs,
     takeRealRegs,
-    mapRegFormatSet,
 )
 
 where
@@ -43,6 +42,7 @@ import GHC.Types.Unique.Set
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 
+
 {- Note [GHC's data format representations]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 GHC has severals types that represent various aspects of data format.
@@ -239,5 +239,3 @@ takeRealRegs = mapMaybeUniqSet_sameUnique $
   \ case { RegFormat { regFormatReg = RegReal rr } -> Just rr; _ -> Nothing }
   -- See Note [Unique Determinism and code generation]
 
-mapRegFormatSet :: (Reg -> Reg) -> UniqSet RegFormat -> UniqSet RegFormat
-mapRegFormatSet f = mapUniqSet (\ ( RegFormat r fmt ) -> RegFormat ( f r ) fmt)


=====================================
compiler/GHC/CmmToAsm/Reg/Graph.hs
=====================================
@@ -33,7 +33,7 @@ import GHC.Platform
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.Supply
-import GHC.Utils.Misc (seqList)
+import GHC.Utils.Misc (seqList, HasDebugCallStack)
 import GHC.CmmToAsm.CFG
 
 import Data.Maybe
@@ -96,7 +96,8 @@ regAlloc config regsFree slotsFree slotsCount code cfg
 regAlloc_spin
         :: forall instr statics.
            (Instruction instr,
-            OutputableP Platform statics)
+            OutputableP Platform statics,
+            HasDebugCallStack)
         => NCGConfig
         -> Int  -- ^ Number of solver iterations we've already performed.
         -> Color.Triv VirtualReg RegClass RealReg


=====================================
compiler/GHC/CmmToAsm/Reg/Linear.hs
=====================================
@@ -727,7 +727,7 @@ saveClobberedTemps clobbered dying
 
               -- (2) no free registers: spill the value
               [] -> do
-                  (spill, slot)   <- spillR (RegFormat (RegReal reg) fmt) temp
+                  (spill, slot)   <- spillR (mkRegFormat platform (RegReal reg) fmt) temp
 
                   -- record why this reg was spilled for profiling
                   recordSpill (SpillClobber temp)
@@ -891,7 +891,7 @@ allocRegsAndSpill_spill reading keep spills alloc (VirtualRegFormat r fmt) rs as
                         = reg
                         | otherwise
                         = first_free
-                spills'   <- loadTemp (VirtualRegFormat r fmt) spill_loc final_reg spills
+                spills'   <- loadTemp platform (VirtualRegFormat r fmt) spill_loc final_reg spills
 
                 setAssigR $ toRegMap
                           $ (addToUFM assig r $! newLocation spill_loc $ RealRegUsage final_reg fmt)
@@ -937,7 +937,7 @@ allocRegsAndSpill_spill reading keep spills alloc (VirtualRegFormat r fmt) rs as
                         -- 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 (VirtualRegFormat r fmt) spill_loc my_reg spills
+                        = do    spills' <- loadTemp platform (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
 
@@ -949,7 +949,7 @@ allocRegsAndSpill_spill reading keep spills alloc (VirtualRegFormat r fmt) rs as
                         | (temp_to_push_out, RealRegUsage my_reg fmt) : _
                                         <- candidates_inReg
                         = do
-                                (spill_store, slot) <- spillR (RegFormat (RegReal my_reg) fmt) temp_to_push_out
+                                (spill_store, slot) <- spillR (mkRegFormat platform (RegReal my_reg) fmt) temp_to_push_out
 
                                 -- record that this temp was spilled
                                 recordSpill (SpillAlloc temp_to_push_out)
@@ -960,7 +960,7 @@ allocRegsAndSpill_spill reading keep spills alloc (VirtualRegFormat r fmt) rs as
                                 setAssigR $ toRegMap assig2
 
                                 -- if need be, load up a spilled temp into the reg we've just freed up.
-                                spills' <- loadTemp (VirtualRegFormat r fmt) spill_loc my_reg spills
+                                spills' <- loadTemp platform (VirtualRegFormat r fmt) spill_loc my_reg spills
 
                                 allocateRegsAndSpill reading keep
                                         (spill_store ++ spills')
@@ -990,17 +990,18 @@ newLocation _ my_reg = InReg my_reg
 -- | Load up a spilled temporary if we need to (read from memory).
 loadTemp
         :: (Instruction instr)
-        => VirtualRegFormat   -- the temp being loaded
+        => Platform
+        -> 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 (VirtualRegFormat vreg fmt) (ReadMem slot) hreg spills
+loadTemp platform (VirtualRegFormat vreg fmt) (ReadMem slot) hreg spills
  = do
-        insn <- loadR (RegFormat (RegReal hreg) fmt) slot
+        insn <- loadR (mkRegFormat platform (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/Base.hs
=====================================
@@ -12,6 +12,7 @@ module GHC.CmmToAsm.Reg.Linear.Base (
         Loc(..),
         regsOfLoc,
         RealRegUsage(..),
+        mkRealRegUsage,
 
         -- for stats
         SpillReason(..),
@@ -28,6 +29,7 @@ import GHC.Prelude
 import GHC.CmmToAsm.Reg.Linear.StackMap
 import GHC.CmmToAsm.Reg.Liveness
 import GHC.CmmToAsm.Config
+import GHC.Platform
 import GHC.Platform.Reg
 
 import GHC.Utils.Outputable
@@ -38,6 +40,9 @@ import GHC.Cmm.BlockId
 import GHC.Cmm.Dataflow.Label
 import GHC.CmmToAsm.Reg.Utils
 import GHC.CmmToAsm.Format
+import GHC.Platform.Reg.Class
+import GHC.Utils.Panic
+import GHC.CmmToAsm.Reg.Target (targetClassOfRealReg)
 
 import Data.Function ( on )
 
@@ -120,6 +125,25 @@ instance Eq RealRegUsage where
 instance Ord RealRegUsage where
   compare = compare `on` realReg
 
+mkRealRegUsage :: Platform -> RealReg -> Format -> RealRegUsage
+mkRealRegUsage platform reg fmt
+  = assertPpr (regCls == fmtCls)
+    (vcat [ text "mkRealRegUsage: incompatible register & format"
+          , text "reg:" <+> ppr reg <+> dcolon <+> ppr regCls
+          , text "fmt:" <+> ppr fmt <+> parens (ppr fmtCls) ])
+  $ RealRegUsage reg fmt
+  where
+    regCls = targetClassOfRealReg platform reg
+    fmtCls = formatRegClass fmt
+
+-- TODO: SIMD debugging
+formatRegClass :: Format -> RegClass
+formatRegClass fmt
+  | isIntFormat fmt
+  = RcInteger
+  | otherwise
+  = RcFloatOrVector
+
 instance Outputable Loc where
         ppr l = text (show l)
 


=====================================
compiler/GHC/CmmToAsm/Reg/Liveness.hs
=====================================
@@ -48,6 +48,7 @@ import GHC.CmmToAsm.Utils
 import GHC.Cmm.BlockId
 import GHC.Cmm.Dataflow.Label
 import GHC.Cmm
+import GHC.CmmToAsm.Reg.Target
 
 import GHC.Data.Graph.Directed
 import GHC.Utils.Monad
@@ -64,6 +65,7 @@ import GHC.Utils.Monad.State.Strict
 import Data.List (mapAccumL, partition)
 import Data.Maybe
 import Data.IntSet              (IntSet)
+import GHC.Utils.Misc
 
 -----------------------------------------------------------------------------
 
@@ -610,7 +612,7 @@ eraseDeltasLive cmm
 --   also erase reg -> reg moves when the reg is the same.
 --   also erase reg -> reg moves when the destination dies in this instr.
 patchEraseLive
-        :: Instruction instr
+        :: (Instruction instr, HasDebugCallStack)
         => Platform
         -> (Reg -> Reg)
         -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
@@ -663,7 +665,7 @@ patchEraseLive platform patchF cmm
 -- | Patch registers in this LiveInstr, including the liveness information.
 --
 patchRegsLiveInstr
-        :: Instruction instr
+        :: (Instruction instr, HasDebugCallStack)
         => (Reg -> Reg)
         -> LiveInstr instr -> LiveInstr instr
 


=====================================
compiler/GHC/CmmToAsm/Reg/Target.hs
=====================================
@@ -14,7 +14,8 @@ module GHC.CmmToAsm.Reg.Target (
         targetClassOfRealReg,
         targetMkVirtualReg,
         targetRegDotColor,
-        targetClassOfReg
+        targetClassOfReg,
+        mkRegFormat, mapRegFormatSet,
 )
 
 where
@@ -26,8 +27,10 @@ import GHC.Platform.Reg.Class
 import GHC.CmmToAsm.Format
 
 import GHC.Utils.Outputable
+import GHC.Utils.Misc
 import GHC.Utils.Panic
 import GHC.Types.Unique
+import GHC.Types.Unique.Set
 import GHC.Platform
 
 import qualified GHC.CmmToAsm.X86.Regs       as X86
@@ -138,3 +141,25 @@ targetClassOfReg platform reg
  = case reg of
    RegVirtual vr -> classOfVirtualReg vr
    RegReal rr -> targetClassOfRealReg platform rr
+
+mkRegFormat :: HasDebugCallStack => Platform -> Reg -> Format -> RegFormat
+mkRegFormat platform reg fmt
+  = assertPpr (regCls == fmtCls)
+    (vcat [ text "mkRegFormat: incompatible register & format"
+          , text "reg:" <+> ppr reg <+> dcolon <+> ppr regCls
+          , text "fmt:" <+> ppr fmt <+> parens (ppr fmtCls) ])
+  $ RegFormat reg fmt
+  where
+    regCls = targetClassOfReg platform reg
+    fmtCls = formatRegClass fmt
+
+-- TODO: SIMD debugging
+formatRegClass :: Format -> RegClass
+formatRegClass fmt
+  | isIntFormat fmt
+  = RcInteger
+  | otherwise
+  = RcFloatOrVector
+
+mapRegFormatSet :: HasDebugCallStack => (Reg -> Reg) -> UniqSet RegFormat -> UniqSet RegFormat
+mapRegFormatSet f = mapUniqSet (\ ( RegFormat r fmt ) -> RegFormat ( f r ) fmt)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c1487b5bdc322a665e9ab7771f3bbf7c4bf0a13

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c1487b5bdc322a665e9ab7771f3bbf7c4bf0a13
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/14e49814/attachment-0001.html>


More information about the ghc-commits mailing list