[Git][ghc/ghc][wip/ncg-simd] 2 commits: Revert "SIMD: refactor Format datatype"
sheaf (@sheaf)
gitlab at gitlab.haskell.org
Tue Jun 18 09:24:41 UTC 2024
sheaf pushed to branch wip/ncg-simd at Glasgow Haskell Compiler / GHC
Commits:
7abec336 by sheaf at 2024-06-18T10:57:17+02:00
Revert "SIMD: refactor Format datatype"
This reverts commit 84c46f16be09760b64a8b926f1f92ceb853b2da8.
- - - - -
9f603670 by sheaf at 2024-06-18T11:24:19+02:00
SIMD cleanups, remove virtual Float reg
- - - - -
14 changed files:
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/CmmToAsm/AArch64/Regs.hs
- compiler/GHC/CmmToAsm/Format.hs
- compiler/GHC/CmmToAsm/PPC.hs
- compiler/GHC/CmmToAsm/PPC/Instr.hs
- compiler/GHC/CmmToAsm/PPC/Ppr.hs
- compiler/GHC/CmmToAsm/PPC/Regs.hs
- compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs
- compiler/GHC/CmmToAsm/Reg/Linear.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/CmmToAsm/X86/Regs.hs
- compiler/GHC/Platform/Reg.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/AArch64/Ppr.hs
=====================================
@@ -306,7 +306,6 @@ pprReg w r = case r of
RegReal (RealRegSingle i) -> ppr_reg_no w i
-- virtual regs should not show up, but this is helpful for debugging.
RegVirtual (VirtualRegI u) -> text "%vI_" <> pprUniqueAlways u
- RegVirtual (VirtualRegF u) -> text "%vF_" <> pprUniqueAlways u
RegVirtual (VirtualRegD u) -> text "%vD_" <> pprUniqueAlways u
_ -> pprPanic "AArch64.pprReg" (text $ show r)
@@ -336,8 +335,8 @@ pprReg w r = case r of
isFloatOp :: Operand -> Bool
isFloatOp (OpReg _ (RegReal (RealRegSingle i))) | i > 31 = True
-isFloatOp (OpReg _ (RegVirtual (VirtualRegF _))) = True
isFloatOp (OpReg _ (RegVirtual (VirtualRegD _))) = True
+-- SIMD NCG TODO: what about VirtualVecV128? Could be floating-point or not?
isFloatOp _ = False
pprInstr :: IsDoc doc => Platform -> Instr -> doc
=====================================
compiler/GHC/CmmToAsm/AArch64/Regs.hs
=====================================
@@ -111,7 +111,7 @@ virtualRegSqueeze cls vr
RcFloatOrVector
-> case vr of
VirtualRegD{} -> 1
- VirtualRegF{} -> 0
+ VirtualRegV128{} -> 1
_other -> 0
{-# INLINE realRegSqueeze #-}
=====================================
compiler/GHC/CmmToAsm/Format.hs
=====================================
@@ -1,13 +1,7 @@
-{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ViewPatterns #-}
-{-# OPTIONS_GHC -Wno-duplicate-exports #-}
- -- Allow bundling II8, II16... with both Format and ScalarFormat
-
-- | Formats on this architecture
-- A Format is a combination of width and class
--
@@ -19,19 +13,18 @@
-- properly. eg SPARC doesn't care about FF80.
--
module GHC.CmmToAsm.Format (
- Format(Format, VecFormat, II8, II16, II32, II64, FF32, FF64, ..),
+ Format(..),
ScalarFormat(..),
intFormat,
floatFormat,
isIntFormat,
- isIntScalarFormat,
isFloatFormat,
- isFloatScalarFormat,
vecFormat,
isVecFormat,
cmmTypeFormat,
formatToWidth,
formatInBytes,
+ isIntScalarFormat,
RegFormat(..),
takeVirtualRegs,
takeRealRegs,
@@ -49,9 +42,6 @@ import GHC.Types.Unique.Set
import GHC.Utils.Outputable
import GHC.Utils.Panic
-import Data.Coerce
-import Data.Word (Word8)
-
{- Note [GHC's data format representations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GHC has severals types that represent various aspects of data format.
@@ -87,57 +77,41 @@ These include:
-- here. I've removed them from the x86 version, we'll see what happens --SDM
-- ToDo: quite a few occurrences of Format could usefully be replaced by Width
-newtype Format = MkFormat { formatBits :: Word8 }
- deriving (Eq, Ord)
-newtype ScalarFormat = ScalarFormat { scalarFormatBits :: Word8 }
- deriving (Eq, Ord)
-
-pattern II8, II16, II32, II64, FF32, FF64 :: Coercible a Word8 => a
-pattern II8 <- ( coerce -> ( 0b0_000 :: Word8 ) ) where { II8 = coerce (0b0_000 :: Word8) }
-pattern II16 <- ( coerce -> ( 0b0_001 :: Word8 ) ) where { II16 = coerce (0b0_001 :: Word8) }
-pattern II32 <- ( coerce -> ( 0b0_010 :: Word8 ) ) where { II32 = coerce (0b0_010 :: Word8) }
-pattern II64 <- ( coerce -> ( 0b0_011 :: Word8 ) ) where { II64 = coerce (0b0_011 :: Word8) }
-pattern FF32 <- ( coerce -> ( 0b1_010 :: Word8 ) ) where { FF32 = coerce (0b1_010 :: Word8) }
-pattern FF64 <- ( coerce -> ( 0b1_011 :: Word8 ) ) where { FF64 = coerce (0b1_011 :: Word8) }
-
-pattern Format :: Length -> ScalarFormat -> Format
-pattern Format lg b <- ( getFormat -> (# _, lg, b #) )
- where
- Format lg b = MkFormat $ scalarFormatBits b .|. ( fromIntegral ( finiteBitSize lg - 1 - countLeadingZeros lg ) `shiftL` 4 )
-pattern VecFormat :: Length -> ScalarFormat -> Format
-pattern VecFormat lg b <- ( getFormat -> (# True, lg, b #) )
- where
- VecFormat lg b = Format lg b
-
-{-# COMPLETE Format :: Format #-}
-{-# COMPLETE II8, II16, II32, II64, FF32, FF64, VecFormat :: Format #-}
-{-# COMPLETE II8, II16, II32, II64, FF32, FF64 :: ScalarFormat #-}
-getFormat :: Format -> (# Bool, Length, ScalarFormat #)
-getFormat ( MkFormat b ) = (# lg > 1, lg, ScalarFormat (b .&. 0b0000_1111) #)
- where
- lg = bit ( fromIntegral b `shiftR` 4 )
-
-instance Show ScalarFormat where
- show = \case
- II8 -> "II8"
- II16 -> "II16"
- II32 -> "II32"
- II64 -> "II64"
- FF32 -> "FF32"
- FF64 -> "FF64"
-instance Show Format where
- show (Format l f)
- | l == 1
- = show f
- | otherwise
- = "V" ++ show l ++ show f
+
+data Format
+ = II8
+ | II16
+ | II32
+ | II64
+ | FF32
+ | FF64
+ | VecFormat !Length -- ^ number of elements
+ !ScalarFormat -- ^ format of each element
+ deriving (Show, Eq, Ord)
+
instance Outputable Format where
ppr fmt = text (show fmt)
+data ScalarFormat
+ = FmtInt8
+ | FmtInt16
+ | FmtInt32
+ | FmtInt64
+ | FmtFloat
+ | FmtDouble
+ deriving (Show, Eq, Ord)
+
+isIntScalarFormat :: ScalarFormat -> Bool
+isIntScalarFormat FmtInt8 = True
+isIntScalarFormat FmtInt16 = True
+isIntScalarFormat FmtInt32 = True
+isIntScalarFormat FmtInt64 = True
+isIntScalarFormat _ = False
+
-- | Get the integer format of this width.
intFormat :: Width -> Format
intFormat width
- = case width of
+ = case width of
W8 -> II8
W16 -> II16
W32 -> II32
@@ -149,37 +123,36 @@ intFormat width
-- | Check if a format represents a vector
isVecFormat :: Format -> Bool
isVecFormat (VecFormat {}) = True
-isVecFormat _ = False
+isVecFormat _ = False
-- | Get the float format of this width.
floatFormat :: Width -> Format
floatFormat width
= case width of
- W32 -> FF32
- W64 -> FF64
- other -> pprPanic "Format.floatFormat" (ppr other)
+ W32 -> FF32
+ W64 -> FF64
+
+ other -> pprPanic "Format.floatFormat" (ppr other)
--- | Check if a format represents a scalar integer value.
+-- | Check if a format represent an integer value.
isIntFormat :: Format -> Bool
-isIntFormat(Format l f)
- = l == 1 && isIntScalarFormat f
-isIntScalarFormat :: ScalarFormat -> Bool
-isIntScalarFormat = not . isFloatScalarFormat
+isIntFormat = not . isFloatFormat
--- | Check if a format represents a scalar floating point value.
+-- | Check if a format represents a floating point value.
isFloatFormat :: Format -> Bool
-isFloatFormat (Format l f)
- = l == 1 && isFloatScalarFormat f
+isFloatFormat format
+ = case format of
+ FF32 -> True
+ FF64 -> True
+ _ -> False
-isFloatScalarFormat :: ScalarFormat -> Bool
-isFloatScalarFormat (ScalarFormat b) = testBit b 3
-- | 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)
+ | isFloatType ty = floatFormat (typeWidth ty)
+ | isVecType ty = vecFormat ty
+ | otherwise = intFormat (typeWidth ty)
vecFormat :: CmmType -> Format
vecFormat ty =
@@ -187,31 +160,37 @@ vecFormat ty =
elemTy = vecElemType ty
in if isFloatType elemTy
then case typeWidth elemTy of
- W32 -> Format l FF32
- W64 -> Format l FF64
+ W32 -> VecFormat l FmtFloat
+ W64 -> VecFormat l FmtDouble
_ -> pprPanic "Incorrect vector element width" (ppr elemTy)
else case typeWidth elemTy of
- W8 -> Format l II8
- W16 -> Format l II16
- W32 -> Format l II32
- W64 -> Format l II64
+ W8 -> VecFormat l FmtInt8
+ W16 -> VecFormat l FmtInt16
+ W32 -> VecFormat l FmtInt32
+ W64 -> VecFormat l FmtInt64
_ -> pprPanic "Incorrect vector element width" (ppr elemTy)
-- | Get the Width of a Format.
formatToWidth :: Format -> Width
-formatToWidth (Format l f)
- | l == 1
- = go f
- | otherwise
- = widthFromBytes (l * widthInBytes (go f))
- where
- go = \case
- II8 -> W8
- II16 -> W16
- II32 -> W32
- II64 -> W64
- FF32 -> W32
- FF64 -> W64
+formatToWidth format
+ = case format of
+ II8 -> W8
+ II16 -> W16
+ II32 -> W32
+ II64 -> W64
+ FF32 -> W32
+ FF64 -> W64
+ VecFormat l s ->
+ widthFromBytes (l * widthInBytes (scalarWidth s))
+
+scalarWidth :: ScalarFormat -> Width
+scalarWidth = \case
+ FmtInt8 -> W8
+ FmtInt16 -> W16
+ FmtInt32 -> W32
+ FmtInt64 -> W64
+ FmtFloat -> W32
+ FmtDouble -> W64
formatInBytes :: Format -> Int
formatInBytes = widthInBytes . formatToWidth
@@ -248,4 +227,4 @@ takeRealRegs = mapMaybeUniqSet_sameUnique $
-- See Note [Unique Determinism and code generation]
mapRegFormatSet :: (Reg -> Reg) -> UniqSet RegFormat -> UniqSet RegFormat
-mapRegFormatSet f = mapUniqSet ( \ ( RegFormat r fmt ) -> RegFormat ( f r ) fmt )
+mapRegFormatSet f = mapUniqSet (\ ( RegFormat r fmt ) -> RegFormat ( f r ) fmt)
=====================================
compiler/GHC/CmmToAsm/PPC.hs
=====================================
@@ -48,8 +48,8 @@ instance Instruction PPC.Instr where
jumpDestsOfInstr = PPC.jumpDestsOfInstr
canFallthroughTo = PPC.canFallthroughTo
patchJumpInstr = PPC.patchJumpInstr
- mkSpillInstr = PPC.mkSpillInstr
- mkLoadInstr = PPC.mkLoadInstr
+ mkSpillInstr cfg reg _ i j = PPC.mkSpillInstr cfg reg i j
+ mkLoadInstr cfg reg _ i j = PPC.mkLoadInstr cfg reg i j
takeDeltaInstr = PPC.takeDeltaInstr
isMetaInstr = PPC.isMetaInstr
mkRegRegMoveInstr _ = PPC.mkRegRegMoveInstr
=====================================
compiler/GHC/CmmToAsm/PPC/Instr.hs
=====================================
@@ -41,7 +41,9 @@ import GHC.CmmToAsm.PPC.Cond
import GHC.CmmToAsm.Types
import GHC.CmmToAsm.Instr (RegUsage(..), noUsage)
import GHC.CmmToAsm.Format
+import GHC.CmmToAsm.Reg.Target
import GHC.CmmToAsm.Config
+import GHC.Platform.Reg.Class
import GHC.Platform.Reg
import GHC.Platform.Regs
@@ -66,8 +68,8 @@ import Data.Maybe (fromMaybe)
--
archWordFormat :: Bool -> Format
archWordFormat is32Bit
- | is32Bit = II32
- | otherwise = II64
+ | is32Bit = II32
+ | otherwise = II64
mkStackAllocInstr :: Platform -> Int -> [Instr]
@@ -549,16 +551,21 @@ patchJumpInstr insn patchF
mkSpillInstr
:: NCGConfig
-> Reg -- register to spill
- -> Format
-> Int -- current stack delta
-> Int -- spill slot to use
-> [Instr]
-mkSpillInstr config reg fmt delta slot
+mkSpillInstr config reg delta slot
= let platform = ncgPlatform config
off = spillSlotToOffset platform slot
+ arch = platformArch platform
in
- let instr = case makeImmediate W32 True (off-delta) of
+ let fmt = case targetClassOfReg platform reg of
+ RcInteger -> case arch of
+ ArchPPC -> II32
+ _ -> II64
+ RcFloatOrVector -> FF64
+ instr = case makeImmediate W32 True (off-delta) of
Just _ -> ST
Nothing -> STFAR -- pseudo instruction: 32 bit offsets
@@ -568,16 +575,21 @@ mkSpillInstr config reg fmt delta slot
mkLoadInstr
:: NCGConfig
-> Reg -- register to load
- -> Format
-> Int -- current stack delta
-> Int -- spill slot to use
-> [Instr]
-mkLoadInstr config reg fmt delta slot
+mkLoadInstr config reg delta slot
= let platform = ncgPlatform config
off = spillSlotToOffset platform slot
+ arch = platformArch platform
in
- let instr = case makeImmediate W32 True (off-delta) of
+ let fmt = case targetClassOfReg platform reg of
+ RcInteger -> case arch of
+ ArchPPC -> II32
+ _ -> II64
+ RcFloatOrVector -> FF64
+ instr = case makeImmediate W32 True (off-delta) of
Just _ -> LD
Nothing -> LDFAR -- pseudo instruction: 32 bit offsets
=====================================
compiler/GHC/CmmToAsm/PPC/Ppr.hs
=====================================
@@ -199,7 +199,6 @@ pprReg r
RegReal (RealRegSingle i) -> ppr_reg_no i
RegVirtual (VirtualRegI u) -> text "%vI_" <> pprUniqueAlways u
RegVirtual (VirtualRegHi u) -> text "%vHi_" <> pprUniqueAlways u
- RegVirtual (VirtualRegF u) -> text "%vF_" <> pprUniqueAlways u
RegVirtual (VirtualRegD u) -> text "%vD_" <> pprUniqueAlways u
RegVirtual (VirtualRegV128 u) -> text "%vV128_" <> pprUniqueAlways u
=====================================
compiler/GHC/CmmToAsm/PPC/Regs.hs
=====================================
@@ -86,7 +86,7 @@ virtualRegSqueeze cls vr
RcFloatOrVector
-> case vr of
VirtualRegD{} -> 1
- VirtualRegF{} -> 0
+ VirtualRegV128{} -> 1
_other -> 0
{-# INLINE realRegSqueeze #-}
@@ -108,14 +108,13 @@ realRegSqueeze cls rr
mkVirtualReg :: Unique -> Format -> VirtualReg
-mkVirtualReg u fmt =
- case fmt of
- VecFormat {} -> panic "mkVirtualReg: vector register"
- _ | not (isFloatFormat fmt)
- -> VirtualRegI u
- FF32 -> VirtualRegD u
- FF64 -> VirtualRegD u
- _ -> panic "mkVirtualReg"
+mkVirtualReg u format
+ | not (isFloatFormat format) = VirtualRegI u
+ | otherwise
+ = case format of
+ FF32 -> VirtualRegD u
+ FF64 -> VirtualRegD u
+ _ -> panic "mkVirtualReg"
regDotColor :: RealReg -> SDoc
regDotColor reg
=====================================
compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs
=====================================
@@ -239,8 +239,8 @@ allocatableRegsInteger
= length $ filter (\r -> regClass r == RcInteger)
$ map RealReg allocatableRegs
-allocatableRegsFloat :: Int
-allocatableRegsFloat
- = length $ filter (\r -> regClass r == RcFloatOrVector
+allocatableRegsDouble :: Int
+allocatableRegsDouble
+ = length $ filter (\r -> regClass r == RcFloatOrVector)
$ map RealReg allocatableRegs
-}
=====================================
compiler/GHC/CmmToAsm/Reg/Linear.hs
=====================================
@@ -873,7 +873,7 @@ allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
let regclass = classOfVirtualReg r
freeRegs_thisClass = frGetFreeRegs platform regclass freeRegs :: [RealReg]
vr_fmt = case r of
- VirtualRegV128 {} -> VecFormat 2 FF64
+ 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
=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -1220,12 +1220,12 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
vector_float_negate_avx :: Length -> Width -> CmmExpr -> NatM Register
vector_float_negate_avx l w expr = do
- tmp <- getNewRegNat (VecFormat l FF32)
+ tmp <- getNewRegNat (VecFormat l FmtFloat)
(reg, exp) <- getSomeReg expr
Amode addr addr_code <- memConstant (mkAlignment $ widthInBytes W32) (CmmFloat 0.0 W32)
let format = case w of
- W32 -> VecFormat l FF32
- W64 -> VecFormat l FF64
+ W32 -> VecFormat l FmtFloat
+ W64 -> VecFormat l FmtDouble
_ -> pprPanic "Cannot negate vector of width" (ppr w)
code dst = case w of
W32 -> exp `appOL` addr_code `snocOL`
@@ -1240,11 +1240,11 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
vector_float_negate_sse :: Length -> Width -> CmmExpr -> NatM Register
vector_float_negate_sse l w expr = do
- tmp <- getNewRegNat (VecFormat l FF32)
+ tmp <- getNewRegNat (VecFormat l FmtFloat)
(reg, exp) <- getSomeReg expr
let format = case w of
- W32 -> VecFormat l FF32
- W64 -> VecFormat l FF64
+ W32 -> VecFormat l FmtFloat
+ W64 -> VecFormat l FmtDouble
_ -> pprPanic "Cannot negate vector of width" (ppr w)
code dst = exp `snocOL`
(XOR format (OpReg tmp) (OpReg tmp)) `snocOL`
@@ -1260,7 +1260,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
vector_float_broadcast_avx len W32 expr
= do
(reg, exp) <- getSomeReg expr
- let f = VecFormat len FF32
+ let f = VecFormat len FmtFloat
addr = spRel platform 0
in return $ Any f (\dst -> exp `snocOL`
(MOVU f (OpReg reg) (OpAddr addr)) `snocOL`
@@ -1268,7 +1268,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
vector_float_broadcast_avx len W64 expr
= do
(reg, exp) <- getSomeReg expr
- let f = VecFormat len FF64
+ let f = VecFormat len FmtDouble
addr = spRel platform 0
in return $ Any f (\dst -> exp `snocOL`
(MOVU f (OpReg reg) (OpAddr addr)) `snocOL`
@@ -1284,7 +1284,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
vector_float_broadcast_sse len W32 expr
= do
(reg, exp) <- getSomeReg expr
- let f = VecFormat len FF32
+ let f = VecFormat len FmtFloat
addr = spRel platform 0
code dst = exp `snocOL`
(MOVU f (OpReg reg) (OpAddr addr)) `snocOL`
@@ -1307,7 +1307,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
vector_int_broadcast len W64 expr
= do
(reg, exp) <- getSomeReg expr
- let fmt = VecFormat len II64
+ let fmt = VecFormat len FmtInt64
return $ Any fmt (\dst -> exp `snocOL`
(MOV II64 (OpReg reg) (OpReg dst)) `snocOL`
(PUNPCKLQDQ fmt (OpReg dst) dst) `snocOL`
@@ -1652,8 +1652,8 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
(reg1, exp1) <- getSomeReg expr1
(reg2, exp2) <- getSomeReg expr2
let format = case w of
- W32 -> VecFormat l FF32
- W64 -> VecFormat l FF64
+ W32 -> VecFormat l FmtFloat
+ W64 -> VecFormat l FmtDouble
_ -> pprPanic "Operation not supported for width " (ppr w)
code dst = case op of
VA_Add -> arithInstr VADD
@@ -1676,8 +1676,8 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
(reg1, exp1) <- getSomeReg expr1
(reg2, exp2) <- getSomeReg expr2
let format = case w of
- W32 -> VecFormat l FF32
- W64 -> VecFormat l FF64
+ W32 -> VecFormat l FmtFloat
+ W64 -> VecFormat l FmtDouble
_ -> pprPanic "Operation not supported for width " (ppr w)
code dst = case op of
VA_Add -> arithInstr ADD
@@ -1700,22 +1700,22 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
vector_float_unpack l W32 expr (CmmLit lit)
= do
(r, exp) <- getSomeReg expr
- let format = VecFormat l FF32
+ let format = VecFormat l FmtFloat
imm = litToImm lit
code dst
= case lit of
- CmmInt 0 _ -> exp `snocOL` (MOVSD FF32 (OpReg r) (OpReg dst))
+ CmmInt 0 _ -> exp `snocOL` (MOV FF32 (OpReg r) (OpReg dst))
CmmInt _ _ -> exp `snocOL` (VPSHUFD format imm (OpReg r) dst)
_ -> panic "Error in offset while unpacking"
return (Any format code)
vector_float_unpack l W64 expr (CmmLit lit)
= do
(r, exp) <- getSomeReg expr
- let format = VecFormat l FF64
+ let format = VecFormat l FmtDouble
code dst
= case lit of
CmmInt 0 _ -> exp `snocOL`
- (MOVSD FF64 (OpReg r) (OpReg dst))
+ (MOV FF64 (OpReg r) (OpReg dst))
CmmInt 1 _ -> exp `snocOL`
(MOVHLPS format (OpReg r) dst)
_ -> panic "Error in offset while unpacking"
@@ -1732,7 +1732,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
vector_float_unpack_sse l W32 expr (CmmLit lit)
= do
(r,exp) <- getSomeReg expr
- let format = VecFormat l FF32
+ let format = VecFormat l FmtFloat
imm = litToImm lit
code dst
= case lit of
@@ -1752,7 +1752,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
vector_int_unpack_sse l at 2 W64 expr (CmmLit lit)
= do
(r, exp) <- getSomeReg expr
- let fmt = VecFormat l II64
+ let fmt = VecFormat l FmtInt64
tmp <- getNewRegNat fmt
let code dst
= case lit of
@@ -1770,7 +1770,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
vector_shuffle_float l w v1 v2 is = do
(r1, exp1) <- getSomeReg v1
(r2, exp2) <- getSomeReg v2
- let fmt = VecFormat l (if w == W32 then FF32 else FF64)
+ let fmt = VecFormat l (if w == W32 then FmtFloat else FmtDouble)
code dst
= exp1 `appOL` (exp2 `appOL` shuffleInstructions fmt r1 r2 is dst)
return (Any fmt code)
@@ -1778,7 +1778,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
shuffleInstructions :: Format -> Reg -> Reg -> [Int] -> Reg -> OrdList Instr
shuffleInstructions fmt v1 v2 is dst =
case fmt of
- VecFormat 2 FF64 ->
+ VecFormat 2 FmtDouble ->
case is of
[i1, i2] -> case (i1, i2) of
(0,0) -> unitOL (VSHUFPD fmt (ImmInt 0b00) (OpReg v1) v1 dst)
@@ -1799,7 +1799,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
(3,1) -> unitOL (VSHUFPD fmt (ImmInt 0b11) (OpReg v1) v2 dst)
_ -> pprPanic "vector shuffle: indices out of bounds 0 <= i <= 3" (ppr is)
_ -> pprPanic "vector shuffle: wrong number of indices (expected 2)" (ppr is)
- VecFormat 4 FF32
+ VecFormat 4 FmtFloat
-- indices 0 <= i <= 7
| all ( (>= 0) <&&> (<= 7) ) is ->
case is of
@@ -1885,7 +1885,7 @@ getRegister' platform _is32Bit (CmmMachOp mop [x, y, z]) = do -- ternary MachOps
= do
fn <- getAnyReg vecExpr
(r, exp) <- getSomeReg valExpr
- let fmt = VecFormat len FF32
+ let fmt = VecFormat len FmtFloat
imm = litToImm (CmmInt (offset `shiftL` 4) W32)
code dst = exp `appOL`
(fn dst) `snocOL`
@@ -1896,16 +1896,16 @@ getRegister' platform _is32Bit (CmmMachOp mop [x, y, z]) = do -- ternary MachOps
= do
(valReg, valExp) <- getSomeReg valExpr
(vecReg, vecExp) <- getSomeReg vecExpr
- let fmt = VecFormat len FF64
+ let fmt = VecFormat len FmtDouble
code dst
= case offset of
CmmInt 0 _ -> valExp `appOL`
vecExp `snocOL`
- (MOVSD FF64 (OpReg valReg) (OpReg dst)) `snocOL`
+ (MOV FF64 (OpReg valReg) (OpReg dst)) `snocOL`
(SHUFPD fmt (ImmInt 0b00) (OpReg vecReg) dst)
CmmInt 1 _ -> valExp `appOL`
vecExp `snocOL`
- (MOVSD FF64 (OpReg vecReg) (OpReg dst)) `snocOL`
+ (MOV FF64 (OpReg vecReg) (OpReg dst)) `snocOL`
(SHUFPD fmt (ImmInt 0b00) (OpReg valReg) dst)
_ -> pprPanic "MO_VF_Insert DoubleX2: unsupported offset" (ppr offset)
in return $ Any fmt code
@@ -1934,7 +1934,7 @@ getRegister' platform _is32Bit (CmmMachOp mop [x, y, z]) = do -- ternary MachOps
pprTraceM "vecExpr:" (pdoc platform vecExpr)
(valReg, valExp) <- getSomeReg valExpr
(vecReg, vecExp) <- getSomeReg vecExpr
- let fmt = VecFormat len II64
+ let fmt = VecFormat len FmtInt64
tmp <- getNewRegNat fmt
pprTraceM "tmp:" (ppr tmp)
let code dst
@@ -2382,7 +2382,7 @@ addAlignmentCheck align reg =
where
check :: Format -> Reg -> InstrBlock
check fmt reg =
- assert (isIntFormat fmt) $
+ assert (not $ isFloatFormat fmt) $
toOL [ TEST fmt (OpImm $ ImmInt $ align-1) (OpReg reg)
, JXX_GBL NE $ ImmCLbl mkBadAlignmentLabel
]
=====================================
compiler/GHC/CmmToAsm/X86/Instr.hs
=====================================
@@ -373,7 +373,6 @@ data Instr
| MOVA Format Operand Operand
| MOVDQU Format Operand Operand
| VMOVDQU Format Operand Operand
- | MOVSD Format Operand Operand
-- logic operations
| VPXOR Format Reg Reg Reg
@@ -530,7 +529,6 @@ regUsageOfInstr platform instr
MOVH fmt src dst -> mkRU fmt (use_R src []) (use_R dst [])
MOVDQU fmt src dst -> mkRU fmt (use_R src []) (use_R dst [])
VMOVDQU fmt src dst -> mkRU fmt (use_R src []) (use_R dst [])
- MOVSD fmt src dst -> mkRU fmt (use_R src []) (use_R dst [])
VPXOR fmt s1 s2 dst -> mkRU fmt [s1,s2] [dst]
@@ -746,7 +744,6 @@ patchRegsOfInstr instr env
MOVH fmt src dst -> MOVH fmt (patchOp src) (patchOp dst)
MOVDQU fmt src dst -> MOVDQU fmt (patchOp src) (patchOp dst)
VMOVDQU fmt src dst -> VMOVDQU fmt (patchOp src) (patchOp dst)
- MOVSD fmt src dst -> MOVSD fmt (patchOp src) (patchOp dst)
VPXOR fmt s1 s2 dst -> VPXOR fmt (env s1) (env s2) (env dst)
@@ -968,9 +965,6 @@ mkRegRegMoveInstr _platform fmt@(VecFormat _ s) src dst
then MOVU fmt (OpReg src) (OpReg dst)
else VMOVU fmt (OpReg src) (OpReg dst)
mkRegRegMoveInstr _platform fmt src dst
- | isFloatFormat fmt
- = MOVSD fmt (OpReg src) (OpReg dst)
- | otherwise
= MOV fmt (OpReg src) (OpReg dst)
-- | Check whether an instruction represents a reg-reg move.
@@ -991,7 +985,7 @@ takeRegRegMoveInstr platform (MOV fmt (OpReg r1) (OpReg r2))
-- some instructions only support XMM registers.
, targetClassOfReg platform r1 == targetClassOfReg platform r2
= Just (r1,r2)
-takeRegRegMoveInstr _ (MOVSD fmt (OpReg r1) (OpReg r2))
+takeRegRegMoveInstr _ (MOV fmt (OpReg r1) (OpReg r2))
| not (isVecFormat fmt)
= Just (r1,r2)
takeRegRegMoveInstr _ (MOVA _ (OpReg r1) (OpReg r2))
=====================================
compiler/GHC/CmmToAsm/X86/Ppr.hs
=====================================
@@ -293,7 +293,6 @@ pprReg platform f r
else ppr64_reg_no f i
RegVirtual (VirtualRegI u) -> text "%vI_" <> pprUniqueAlways u
RegVirtual (VirtualRegHi u) -> text "%vHi_" <> pprUniqueAlways u
- RegVirtual (VirtualRegF u) -> text "%vF_" <> pprUniqueAlways u
RegVirtual (VirtualRegD u) -> text "%vD_" <> pprUniqueAlways u
RegVirtual (VirtualRegV128 u) -> text "%vVec_" <> pprUniqueAlways u
@@ -431,13 +430,13 @@ pprFormat x = case x of
II64 -> text "q"
FF32 -> text "ss" -- "scalar single-precision float" (SSE2)
FF64 -> text "sd" -- "scalar double-precision float" (SSE2)
- VecFormat _ FF32 -> text "ps"
- VecFormat _ FF64 -> text "pd"
+ VecFormat _ FmtFloat -> text "ps"
+ VecFormat _ FmtDouble -> text "pd"
-- TODO: this is shady because it only works for certain instructions
- VecFormat _ II8 -> text "b"
- VecFormat _ II16 -> text "w"
- VecFormat _ II32 -> text "l"
- VecFormat _ II64 -> text "q"
+ VecFormat _ FmtInt8 -> text "b"
+ VecFormat _ FmtInt16 -> text "w"
+ VecFormat _ FmtInt32 -> text "l"
+ VecFormat _ FmtInt64 -> text "q"
pprFormat_x87 :: IsLine doc => Format -> doc
pprFormat_x87 x = case x of
@@ -781,9 +780,9 @@ pprInstr platform i = case i of
BT format imm src
-> pprFormatImmOp (text "bt") format imm src
- CMP fmt@(Format _ s) src dst
- | isFloatScalarFormat s -> pprFormatOpOp (text "ucomi") fmt src dst -- SSE2
- | otherwise -> pprFormatOpOp (text "cmp") fmt src dst
+ CMP format src dst
+ | isFloatFormat format -> pprFormatOpOp (text "ucomi") format src dst -- SSE2
+ | otherwise -> pprFormatOpOp (text "cmp") format src dst
TEST format src dst
-> pprFormatOpOp (text "test") format' src dst
@@ -973,8 +972,6 @@ pprInstr platform i = case i of
-> pprOpOp (text "movdqu") format from to
VMOVDQU format from to
-> pprOpOp (text "vmovdqu") format from to
- MOVSD format from to
- -> pprOpOp (text "movsd") format from to
VPXOR format s1 s2 dst
-> pprXor (text "vpxor") format s1 s2 dst
@@ -1051,13 +1048,14 @@ pprInstr platform i = case i of
char '\t' <> name <> pprBroadcastFormat format <> space
pprBroadcastFormat :: Format -> Line doc
- pprBroadcastFormat (VecFormat _ f) = case f of
- FF32 -> text "ss"
- FF64 -> text "sd"
- II8 -> text "b"
- II16 -> text "w"
- II32 -> text "d"
- II64 -> text "q"
+ pprBroadcastFormat (VecFormat _ f)
+ = case f of
+ FmtFloat -> text "ss"
+ FmtDouble -> text "sd"
+ FmtInt8 -> text "b"
+ FmtInt16 -> text "w"
+ FmtInt32 -> text "d"
+ FmtInt64 -> text "q"
pprBroadcastFormat _ = panic "Scalar Format invading vector operation"
pprFormatImmOp :: Line doc -> Format -> Imm -> Operand -> doc
=====================================
compiler/GHC/CmmToAsm/X86/Regs.hs
=====================================
@@ -80,8 +80,7 @@ virtualRegSqueeze cls vr
RcFloatOrVector
-> case vr of
VirtualRegD{} -> 1
- VirtualRegF{} -> 0
- VirtualRegV128{} -> 1
+ VirtualRegV128{} -> 1
_other -> 0
=====================================
compiler/GHC/Platform/Reg.hs
=====================================
@@ -60,8 +60,6 @@ data VirtualReg
= VirtualRegI { virtualRegUnique :: {-# UNPACK #-} !Unique }
-- | High part of 2-word virtual register
| VirtualRegHi { virtualRegUnique :: {-# UNPACK #-} !Unique }
- -- | Float virtual register
- | VirtualRegF { virtualRegUnique :: {-# UNPACK #-} !Unique }
-- | Double virtual register
| VirtualRegD { virtualRegUnique :: {-# UNPACK #-} !Unique }
-- | 128-bit wide vector virtual register
@@ -87,7 +85,6 @@ instance Outputable VirtualReg where
= case reg of
VirtualRegI u -> text "%vI_" <> pprUniqueAlways u
VirtualRegHi u -> text "%vHi_" <> pprUniqueAlways u
- VirtualRegF u -> text "%vFloat_" <> pprUniqueAlways u
VirtualRegD u -> text "%vDouble_" <> pprUniqueAlways u
VirtualRegV128 u -> text "%vV128_" <> pprUniqueAlways u
@@ -100,7 +97,6 @@ classOfVirtualReg vr
= case vr of
VirtualRegI{} -> RcInteger
VirtualRegHi{} -> RcInteger
- VirtualRegF{} -> RcFloatOrVector
VirtualRegD{} -> RcFloatOrVector
VirtualRegV128{} -> RcFloatOrVector
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62168cfcccf795af856a9a096af78c599502477c...9f6036704c0dcf4ac93c701a3d281976d62085eb
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62168cfcccf795af856a9a096af78c599502477c...9f6036704c0dcf4ac93c701a3d281976d62085eb
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/20240618/a6ba9f43/attachment-0001.html>
More information about the ghc-commits
mailing list