[Git][ghc/ghc][wip/ncg-simd] debugging mkRegRegMove
sheaf (@sheaf)
gitlab at gitlab.haskell.org
Thu Jun 20 13:26:22 UTC 2024
sheaf pushed to branch wip/ncg-simd at Glasgow Haskell Compiler / GHC
Commits:
1c5e1428 by sheaf at 2024-06-20T15:26:10+02:00
debugging mkRegRegMove
- - - - -
8 changed files:
- compiler/GHC/CmmToAsm.hs
- compiler/GHC/CmmToAsm/Reg/Linear.hs
- compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
- compiler/GHC/CmmToAsm/Reg/Linear/State.hs
- compiler/GHC/CmmToAsm/Reg/Linear/X86.hs
- compiler/GHC/CmmToAsm/Reg/Linear/X86_64.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
Changes:
=====================================
compiler/GHC/CmmToAsm.hs
=====================================
@@ -500,7 +500,7 @@ cmmNativeGen logger ncgImpl us fileIds dbgMap cmm count
if ( ncgRegsGraph config || ncgRegsIterative config )
then do
-- the regs usable for allocation
- let (alloc_regs :: UniqFM RegClass (UniqSet RealReg))
+ let alloc_regs :: UniqFM RegClass (UniqSet RealReg)
= foldr (\r -> plusUFM_C unionUniqSets
$ unitUFM (targetClassOfRealReg platform r) (unitUniqSet r))
emptyUFM
=====================================
compiler/GHC/CmmToAsm/Reg/Linear.hs
=====================================
@@ -704,7 +704,11 @@ saveClobberedTemps clobbered dying
= do platform <- getPlatform
freeRegs <- getFreeRegsR
- let regclass = targetClassOfRealReg platform reg
+ let regclass
+ | isIntFormat fmt
+ = RcInteger
+ | otherwise
+ = RcFloatOrVector
freeRegs_thisClass = frGetFreeRegs platform regclass freeRegs
case filter (`notElem` clobbered) freeRegs_thisClass of
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
=====================================
@@ -55,7 +55,7 @@ getStackSlotFor fs@(StackMap _ reserved) _fmt regUnique
getStackSlotFor (StackMap freeSlot reserved) fmt regUnique =
let
- nbSlots = max 1 (formatInBytes fmt `div` 8)
+ nbSlots = ( formatInBytes fmt + 7 ) `div` 8
in
(StackMap (freeSlot+nbSlots) (addToUFM reserved regUnique freeSlot), freeSlot)
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/State.hs
=====================================
@@ -42,6 +42,7 @@ import GHC.CmmToAsm.Reg.Linear.Stats
import GHC.CmmToAsm.Reg.Linear.StackMap
import GHC.CmmToAsm.Reg.Linear.Base
import GHC.CmmToAsm.Reg.Liveness
+import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.Config
import GHC.Cmm.BlockId
@@ -52,7 +53,7 @@ import GHC.Types.Unique.Supply
import GHC.Exts (oneShot)
import Control.Monad (ap)
-import GHC.CmmToAsm.Format
+
type RA_Result freeRegs a = (# RA_State freeRegs, a #)
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/X86.hs
=====================================
@@ -21,29 +21,27 @@ noFreeRegs = FreeRegs 0
releaseReg :: RealReg -> FreeRegs -> FreeRegs
releaseReg (RealRegSingle n) (FreeRegs f)
- = FreeRegs (f .|. (1 `shiftL` n))
+ = FreeRegs (setBit f n)
initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform
= foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)
getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
-getFreeRegs platform cls (FreeRegs f) = go f 0
-
- where go 0 _ = []
- go n m
- | n .&. 1 /= 0 && compatibleClass m
- = RealRegSingle m : (go (n `shiftR` 1) $! (m+1))
-
- | otherwise
- = go (n `shiftR` 1) $! (m+1)
- -- ToDo: there's no point looking through all the integer registers
- -- in order to find a floating-point one.
- compatibleClass i =
- cls == classOfRealReg platform (RealRegSingle i)
-
+getFreeRegs platform cls (FreeRegs f) =
+ case cls of
+ RcInteger ->
+ [ RealRegSingle i
+ | i <- [ 0 .. lastint platform ]
+ , testBit f i
+ ]
+ RcFloatOrVector ->
+ [ RealRegSingle i
+ | i <- [ lastint platform + 1 .. lastxmm platform ]
+ , testBit f i
+ ]
allocateReg :: RealReg -> FreeRegs -> FreeRegs
allocateReg (RealRegSingle r) (FreeRegs f)
- = FreeRegs (f .&. complement (1 `shiftL` r))
+ = FreeRegs (clearBit f r)
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/X86_64.hs
=====================================
@@ -21,28 +21,27 @@ noFreeRegs = FreeRegs 0
releaseReg :: RealReg -> FreeRegs -> FreeRegs
releaseReg (RealRegSingle n) (FreeRegs f)
- = FreeRegs (f .|. (1 `shiftL` n))
+ = FreeRegs (setBit f n)
initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform
= foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)
getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
-getFreeRegs platform cls (FreeRegs f) = go f 0
-
- where go 0 _ = []
- go n m
- | n .&. 1 /= 0 && compatibleClass m
- = RealRegSingle m : (go (n `shiftR` 1) $! (m+1))
-
- | otherwise
- = go (n `shiftR` 1) $! (m+1)
- -- ToDo: there's no point looking through all the integer registers
- -- in order to find a floating-point one.
- compatibleClass i =
- cls == classOfRealReg platform (RealRegSingle i)
+getFreeRegs platform cls (FreeRegs f) =
+ case cls of
+ RcInteger ->
+ [ RealRegSingle i
+ | i <- [ 0 .. lastint platform ]
+ , testBit f i
+ ]
+ RcFloatOrVector ->
+ [ RealRegSingle i
+ | i <- [ lastint platform + 1 .. lastxmm platform ]
+ , testBit f i
+ ]
allocateReg :: RealReg -> FreeRegs -> FreeRegs
allocateReg (RealRegSingle r) (FreeRegs f)
- = FreeRegs (f .&. complement (1 `shiftL` r))
+ = FreeRegs (clearBit f r)
=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -2086,12 +2086,12 @@ intLoadCode instr mem = do
-- Compute an expression into *any* register, adding the appropriate
-- move instruction if necessary.
-getAnyReg :: CmmExpr -> NatM (Reg -> InstrBlock)
+getAnyReg :: HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg expr = do
r <- getRegister expr
anyReg r
-anyReg :: Register -> NatM (Reg -> InstrBlock)
+anyReg :: HasDebugCallStack => Register -> NatM (Reg -> InstrBlock)
anyReg (Any _ code) = return code
anyReg (Fixed rep reg fcode) = do
platform <- getPlatform
@@ -2100,7 +2100,7 @@ anyReg (Fixed rep reg fcode) = do
-- A bit like getSomeReg, but we want a reg that can be byte-addressed.
-- Fixed registers might not be byte-addressable, so we make sure we've
-- got a temporary, inserting an extra reg copy if necessary.
-getByteReg :: CmmExpr -> NatM (Reg, InstrBlock)
+getByteReg :: HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
getByteReg expr = do
platform <- getPlatform
is32Bit <- is32BitPlatform
@@ -2122,7 +2122,7 @@ getByteReg expr = do
-- Another variant: this time we want the result in a register that cannot
-- be modified by code to evaluate an arbitrary expression.
-getNonClobberedReg :: CmmExpr -> NatM (Reg, InstrBlock)
+getNonClobberedReg :: HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg expr = do
r <- getRegister expr
platform <- ncgPlatform <$> getConfig
=====================================
compiler/GHC/CmmToAsm/X86/Instr.hs
=====================================
@@ -46,10 +46,13 @@ import GHC.Data.FastString
import GHC.CmmToAsm.X86.Cond
import GHC.CmmToAsm.X86.Regs
import GHC.CmmToAsm.Format
+import GHC.CmmToAsm.Reg.Target (targetClassOfReg)
import GHC.CmmToAsm.Types
import GHC.CmmToAsm.Utils
import GHC.CmmToAsm.Instr (RegUsage(..), noUsage)
import GHC.Platform.Reg
+import GHC.Platform.Reg.Class
+
import GHC.CmmToAsm.Config
import GHC.Cmm.BlockId
@@ -66,9 +69,9 @@ import GHC.Types.Unique
import GHC.Types.Unique.Supply
import GHC.Types.Basic (Alignment)
import GHC.Cmm.DebugBlock (UnwindTable)
+import GHC.Utils.Misc ( HasDebugCallStack )
import Data.Maybe (fromMaybe)
-import GHC.CmmToAsm.Reg.Target (targetClassOfReg)
-- Format of an x86/x86_64 memory address, in bytes.
--
@@ -948,7 +951,8 @@ isMetaInstr instr
-- | Make a reg-reg move instruction.
mkRegRegMoveInstr
- :: Platform
+ :: HasDebugCallStack
+ => Platform
-> Format
-> Reg
-> Reg
@@ -965,7 +969,18 @@ mkRegRegMoveInstr platform fmt src dst =
then MOVU fmt (OpReg src) (OpReg dst)
else VMOVU fmt (OpReg src) (OpReg dst)
_ ->
- MOV (scalarMoveFormat platform fmt) (OpReg src) (OpReg dst)
+ let fmt' = scalarMoveFormat platform fmt
+ cls_f = if isIntFormat fmt' then RcInteger else RcFloatOrVector
+ cls1 = targetClassOfReg platform src
+ cls2 = targetClassOfReg platform dst
+ in
+ assertPpr (all (== cls_f) [cls1, cls2])
+ (vcat [ text "mkRegRegMoveInstr: incompatible formats"
+ , text "format:" <+> ppr fmt <+> parens (ppr cls_f)
+ , text "src:" <+> ppr src <+> parens (ppr cls1)
+ , text "dst:" <+> ppr dst <+> parens (ppr cls2)
+ , callStackDoc ])
+ $ MOV (scalarMoveFormat platform fmt) (OpReg src) (OpReg dst)
scalarMoveFormat :: Platform -> Format -> Format
scalarMoveFormat platform fmt
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1c5e1428042ebde5f7c73e53d0860a78deea44b5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1c5e1428042ebde5f7c73e53d0860a78deea44b5
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/478fdc1c/attachment-0001.html>
More information about the ghc-commits
mailing list