Instantly share code, notes, and snippets.

Embed
What would you like to do?
diff --git a/compiler/cmm/CmmCallConv.hs b/compiler/cmm/CmmCallConv.hs
index e1067e9..241a8f5 100644
--- a/compiler/cmm/CmmCallConv.hs
+++ b/compiler/cmm/CmmCallConv.hs
@@ -66,7 +66,7 @@ assignArgumentsPos dflags off conv arg_ty reps = (stk_off, assignments)
| otherwise = int
where vec = case (w, regs) of
(W128, (vs, fs, ds, ls, s:ss))
- | passVectorInReg W128 dflags -> k (RegisterParam (XmmReg s), (vs, fs, ds, ls, ss))
+ | passVectorInReg W128 dflags -> k (RegisterParam (XmmReg s 4 W32), (vs, fs, ds, ls, ss))
(W256, (vs, fs, ds, ls, s:ss))
| passVectorInReg W256 dflags -> k (RegisterParam (YmmReg s), (vs, fs, ds, ls, ss))
(W512, (vs, fs, ds, ls, s:ss))
@@ -211,9 +211,9 @@ realArgRegsCover :: DynFlags -> [GlobalReg]
realArgRegsCover dflags
| passFloatArgsInXmm dflags = map ($VGcPtr) (realVanillaRegs dflags) ++
realLongRegs dflags ++
- map XmmReg (realXmmRegNos dflags)
+ map (\x -> XmmReg x 4 W32) (realXmmRegNos dflags)
| otherwise = map ($VGcPtr) (realVanillaRegs dflags) ++
realFloatRegs dflags ++
realDoubleRegs dflags ++
realLongRegs dflags ++
- map XmmReg (realXmmRegNos dflags)
+ map (\x -> XmmReg x 4 W32) (realXmmRegNos dflags)
diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 2762fdb..256555f 100644
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -421,6 +421,8 @@ data GlobalReg
| XmmReg -- 128-bit SIMD vector register
{-# UNPACK #-} !Int -- its number
+ !Length
+ !Width
| YmmReg -- 256-bit SIMD vector register
{-# UNPACK #-} !Int -- its number
@@ -472,7 +474,7 @@ instance Eq GlobalReg where
FloatReg i == FloatReg j = i==j
DoubleReg i == DoubleReg j = i==j
LongReg i == LongReg j = i==j
- XmmReg i == XmmReg j = i==j
+ XmmReg i l w == XmmReg j l' w' = i==j && l == l' && w == w'
YmmReg i == YmmReg j = i==j
ZmmReg i == ZmmReg j = i==j
Sp == Sp = True
@@ -495,12 +497,12 @@ instance Eq GlobalReg where
instance Ord GlobalReg where
compare (VanillaReg i _) (VanillaReg j _) = compare i j
-- Ignore type when seeking clashes
- compare (FloatReg i) (FloatReg j) = compare i j
- compare (DoubleReg i) (DoubleReg j) = compare i j
- compare (LongReg i) (LongReg j) = compare i j
- compare (XmmReg i) (XmmReg j) = compare i j
- compare (YmmReg i) (YmmReg j) = compare i j
- compare (ZmmReg i) (ZmmReg j) = compare i j
+ compare (FloatReg i) (FloatReg j) = compare i j
+ compare (DoubleReg i) (DoubleReg j) = compare i j
+ compare (LongReg i) (LongReg j) = compare i j
+ compare (XmmReg i _ _) (XmmReg j _ _) = compare i j
+ compare (YmmReg i) (YmmReg j) = compare i j
+ compare (ZmmReg i) (ZmmReg j) = compare i j
compare Sp Sp = EQ
compare SpLim SpLim = EQ
compare Hp Hp = EQ
@@ -524,8 +526,8 @@ instance Ord GlobalReg where
compare _ (DoubleReg _) = GT
compare (LongReg _) _ = LT
compare _ (LongReg _) = GT
- compare (XmmReg _) _ = LT
- compare _ (XmmReg _) = GT
+ compare (XmmReg _ _ _) _ = LT
+ compare _ (XmmReg _ _ _) = GT
compare (YmmReg _) _ = LT
compare _ (YmmReg _) = GT
compare (ZmmReg _) _ = LT
@@ -585,7 +587,7 @@ globalRegType _ (LongReg _) = cmmBits W64
-- NOTE:
-- The below XMM, YMM, ZMM CmmTypes are not fully correct because an
-- XMM can also hold 2 doubles or 16 Int8s etc, similarly for YMM, ZMM
-globalRegType _ (XmmReg _) = cmmVec 2 (cmmFloat W64)
+globalRegType _ (XmmReg _ l w) = cmmVec l (cmmFloat w)
globalRegType _ (YmmReg _) = cmmVec 8 (cmmBits W32)
globalRegType _ (ZmmReg _) = cmmVec 16 (cmmBits W32)
diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs
index 286b1e3..607b715 100644
--- a/compiler/cmm/CmmNode.hs
+++ b/compiler/cmm/CmmNode.hs
@@ -370,7 +370,7 @@ instance DefinerOfRegs GlobalReg (CmmNode e x) where
fold f z n = foldRegsDefd dflags f z n
platform = targetPlatform dflags
- activeRegs = activeStgRegs platform
+ activeRegs = activeStgRegs 4 W32 platform
activeCallerSavesRegs = filter (callerSaves platform) activeRegs
foreignTargetRegs (ForeignTarget _ (ForeignConvention _ _ _ CmmNeverReturns)) = []
diff --git a/compiler/cmm/PprCmmExpr.hs b/compiler/cmm/PprCmmExpr.hs
index 4538556..020561f 100644
--- a/compiler/cmm/PprCmmExpr.hs
+++ b/compiler/cmm/PprCmmExpr.hs
@@ -256,7 +256,7 @@ pprGlobalReg gr
FloatReg n -> char 'F' <> int n
DoubleReg n -> char 'D' <> int n
LongReg n -> char 'L' <> int n
- XmmReg n -> text "XMM" <> int n
+ XmmReg n _ _ -> text "XMM" <> int n
YmmReg n -> text "YMM" <> int n
ZmmReg n -> text "ZMM" <> int n
Sp -> text "Sp"
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 6a28402..5aa7e88 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -51,13 +51,13 @@ baseRegOffset dflags (DoubleReg 4) = oFFSET_StgRegTable_rD4 dflags
baseRegOffset dflags (DoubleReg 5) = oFFSET_StgRegTable_rD5 dflags
baseRegOffset dflags (DoubleReg 6) = oFFSET_StgRegTable_rD6 dflags
baseRegOffset _ (DoubleReg n) = panic ("Registers above D6 are not supported (tried to use D" ++ show n ++ ")")
-baseRegOffset dflags (XmmReg 1) = oFFSET_StgRegTable_rXMM1 dflags
-baseRegOffset dflags (XmmReg 2) = oFFSET_StgRegTable_rXMM2 dflags
-baseRegOffset dflags (XmmReg 3) = oFFSET_StgRegTable_rXMM3 dflags
-baseRegOffset dflags (XmmReg 4) = oFFSET_StgRegTable_rXMM4 dflags
-baseRegOffset dflags (XmmReg 5) = oFFSET_StgRegTable_rXMM5 dflags
-baseRegOffset dflags (XmmReg 6) = oFFSET_StgRegTable_rXMM6 dflags
-baseRegOffset _ (XmmReg n) = panic ("Registers above XMM6 are not supported (tried to use XMM" ++ show n ++ ")")
+baseRegOffset dflags (XmmReg 1 _ _) = oFFSET_StgRegTable_rXMM1 dflags
+baseRegOffset dflags (XmmReg 2 _ _) = oFFSET_StgRegTable_rXMM2 dflags
+baseRegOffset dflags (XmmReg 3 _ _) = oFFSET_StgRegTable_rXMM3 dflags
+baseRegOffset dflags (XmmReg 4 _ _) = oFFSET_StgRegTable_rXMM4 dflags
+baseRegOffset dflags (XmmReg 5 _ _) = oFFSET_StgRegTable_rXMM5 dflags
+baseRegOffset dflags (XmmReg 6 _ _) = oFFSET_StgRegTable_rXMM6 dflags
+baseRegOffset _ (XmmReg n _ _) = panic ("Registers above XMM6 are not supported (tried to use XMM" ++ show n ++ ")")
baseRegOffset dflags (YmmReg 1) = oFFSET_StgRegTable_rYMM1 dflags
baseRegOffset dflags (YmmReg 2) = oFFSET_StgRegTable_rYMM2 dflags
baseRegOffset dflags (YmmReg 3) = oFFSET_StgRegTable_rYMM3 dflags
@@ -144,7 +144,7 @@ fixStgRegStmt dflags stmt = fixAssign $ mapExpDeep fixExpr stmt
| reg == MachSp -> stmt
| otherwise ->
let baseAddr = get_GlobalReg_addr dflags reg
- in case reg `elem` activeStgRegs (targetPlatform dflags) of
+ in case reg `elem` activeStgRegs 4 W32 (targetPlatform dflags) of
True -> CmmAssign (CmmGlobal reg) src
False -> CmmStore baseAddr src
other_stmt -> other_stmt
@@ -159,7 +159,7 @@ fixStgRegStmt dflags stmt = fixAssign $ mapExpDeep fixExpr stmt
-- to mean the address of the reg table in MainCapability,
-- and for all others we generate an indirection to its
-- location in the register table.
- case reg `elem` activeStgRegs platform of
+ case reg `elem` activeStgRegs 4 W32 platform of
True -> expr
False ->
let baseAddr = get_GlobalReg_addr dflags reg
@@ -171,7 +171,7 @@ fixStgRegStmt dflags stmt = fixAssign $ mapExpDeep fixExpr stmt
-- RegOf leaves are just a shorthand form. If the reg maps
-- to a real reg, we keep the shorthand, otherwise, we just
-- expand it and defer to the above code.
- case reg `elem` activeStgRegs platform of
+ case reg `elem` activeStgRegs 4 W32 platform of
True -> expr
False -> CmmMachOp (MO_Add (wordWidth dflags)) [
fixExpr (CmmReg (CmmGlobal reg)),
diff --git a/compiler/codeGen/CodeGen/Platform.hs b/compiler/codeGen/CodeGen/Platform.hs
index 3014a05..961b052 100644
--- a/compiler/codeGen/CodeGen/Platform.hs
+++ b/compiler/codeGen/CodeGen/Platform.hs
@@ -44,23 +44,23 @@ callerSaves platform
-- maintain the order here with the order used in the LLVM calling conventions.
-- Note that also, this isn't all registers, just the ones that are currently
-- possbily mapped to real registers.
-activeStgRegs :: Platform -> [GlobalReg]
-activeStgRegs platform
- | platformUnregisterised platform = NoRegs.activeStgRegs
+activeStgRegs :: Length -> Width -> Platform -> [GlobalReg]
+activeStgRegs l w platform
+ | platformUnregisterised platform = undefined -- (NoRegs.activeStgRegs l w)
| otherwise
= case platformArch platform of
- ArchX86 -> X86.activeStgRegs
- ArchX86_64 -> X86_64.activeStgRegs
- ArchSPARC -> SPARC.activeStgRegs
- ArchARM {} -> ARM.activeStgRegs
- ArchARM64 -> ARM64.activeStgRegs
+ ArchX86 -> X86.activeStgRegs l w
+ ArchX86_64 -> X86_64.activeStgRegs l w
+ ArchSPARC -> SPARC.activeStgRegs l w
+ ArchARM {} -> ARM.activeStgRegs l w
+ ArchARM64 -> ARM64.activeStgRegs l w
arch
| arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] ->
case platformOS platform of
- OSDarwin -> PPC_Darwin.activeStgRegs
- _ -> PPC.activeStgRegs
+ OSDarwin -> PPC_Darwin.activeStgRegs l w
+ _ -> PPC.activeStgRegs l w
- | otherwise -> NoRegs.activeStgRegs
+ | otherwise -> undefined--(NoRegs.activeStgRegs l w)
haveRegBase :: Platform -> Bool
haveRegBase platform
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 6e20da4..8aeb47b 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -147,13 +147,13 @@ llvmFunSection dflags lbl
-- | A Function's arguments
llvmFunArgs :: DynFlags -> LiveGlobalRegs -> [LlvmVar]
llvmFunArgs dflags live =
- map (lmGlobalRegArg dflags) (filter isPassed (activeStgRegs platform))
+ map (lmGlobalRegArg dflags) (filter isPassed (activeStgRegs 4 W32 platform))
where platform = targetPlatform dflags
isLive r = not (isSSE r) || r `elem` alwaysLive || r `elem` live
isPassed r = not (isSSE r) || isLive r
isSSE (FloatReg _) = True
isSSE (DoubleReg _) = True
- isSSE (XmmReg _) = True
+ isSSE (XmmReg _ _ _) = True
isSSE (YmmReg _) = True
isSSE (ZmmReg _) = True
isSSE _ = False
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index 678fffa..3b5441e 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -1808,7 +1808,7 @@ funEpilogue live = do
let liveRegs = alwaysLive ++ live
isSSE (FloatReg _) = True
isSSE (DoubleReg _) = True
- isSSE (XmmReg _) = True
+ isSSE (XmmReg _ _ _) = True
isSSE (YmmReg _) = True
isSSE (ZmmReg _) = True
isSSE _ = False
@@ -1823,7 +1823,7 @@ funEpilogue live = do
let ty = (pLower . getVarType $ lmGlobalRegVar dflags r)
return (Just $ LMLitVar $ LMUndefLit ty, nilOL)
platform <- getDynFlag targetPlatform
- loads <- flip mapM (activeStgRegs platform) $ \r -> case () of
+ loads <- flip mapM (activeStgRegs 4 W32 platform) $ \r -> case () of
_ | r `elem` liveRegs -> loadExpr r
| not (isSSE r) -> loadUndef r
| otherwise -> return (Nothing, nilOL)
@@ -1854,7 +1854,7 @@ getTrashStmts = do
getTrashRegs :: LlvmM [GlobalReg]
getTrashRegs = do plat <- getLlvmPlatform
- return $ filter (callerSaves plat) (activeStgRegs plat)
+ return $ filter (callerSaves plat) (activeStgRegs 4 W32 plat)
-- | Get a function pointer to the CLabel specified.
--
diff --git a/compiler/llvmGen/LlvmCodeGen/Regs.hs b/compiler/llvmGen/LlvmCodeGen/Regs.hs
index 8cdf3c6..6ec3396 100644
--- a/compiler/llvmGen/LlvmCodeGen/Regs.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Regs.hs
@@ -60,12 +60,12 @@ lmGlobalReg dflags suf reg
DoubleReg 4 -> doubleGlobal $ "D4" ++ suf
DoubleReg 5 -> doubleGlobal $ "D5" ++ suf
DoubleReg 6 -> doubleGlobal $ "D6" ++ suf
- XmmReg 1 -> xmmGlobal $ "XMM1" ++ suf
- XmmReg 2 -> xmmGlobal $ "XMM2" ++ suf
- XmmReg 3 -> xmmGlobal $ "XMM3" ++ suf
- XmmReg 4 -> xmmGlobal $ "XMM4" ++ suf
- XmmReg 5 -> xmmGlobal $ "XMM5" ++ suf
- XmmReg 6 -> xmmGlobal $ "XMM6" ++ suf
+ XmmReg 1 _ _ -> xmmGlobal $ "XMM1" ++ suf
+ XmmReg 2 _ _ -> xmmGlobal $ "XMM2" ++ suf
+ XmmReg 3 _ _ -> xmmGlobal $ "XMM3" ++ suf
+ XmmReg 4 _ _ -> xmmGlobal $ "XMM4" ++ suf
+ XmmReg 5 _ _ -> xmmGlobal $ "XMM5" ++ suf
+ XmmReg 6 _ _ -> xmmGlobal $ "XMM6" ++ suf
YmmReg 1 -> ymmGlobal $ "YMM1" ++ suf
YmmReg 2 -> ymmGlobal $ "YMM2" ++ suf
YmmReg 3 -> ymmGlobal $ "YMM3" ++ suf
diff --git a/includes/CodeGen.Platform.hs b/includes/CodeGen.Platform.hs
index 868608a..09b7f26 100644
--- a/includes/CodeGen.Platform.hs
+++ b/includes/CodeGen.Platform.hs
@@ -447,8 +447,8 @@ callerSaves CurrentNursery = True
#endif
callerSaves _ = False
-activeStgRegs :: [GlobalReg]
-activeStgRegs = [
+activeStgRegs :: Length -> Width -> [GlobalReg]
+activeStgRegs l w = [
#if defined(REG_Base)
BaseReg
#endif
@@ -499,7 +499,7 @@ activeStgRegs = [
,DoubleReg 1
#endif
#if defined(REG_XMM1)
- ,XmmReg 1
+ ,XmmReg 1 l w
#endif
#if defined(REG_YMM1)
,YmmReg 1
@@ -514,7 +514,7 @@ activeStgRegs = [
,DoubleReg 2
#endif
#if defined(REG_XMM2)
- ,XmmReg 2
+ ,XmmReg 2 l w
#endif
#if defined(REG_YMM2)
,YmmReg 2
@@ -529,7 +529,7 @@ activeStgRegs = [
,DoubleReg 3
#endif
#if defined(REG_XMM3)
- ,XmmReg 3
+ ,XmmReg 3 l w
#endif
#if defined(REG_YMM3)
,YmmReg 3
@@ -544,7 +544,7 @@ activeStgRegs = [
,DoubleReg 4
#endif
#if defined(REG_XMM4)
- ,XmmReg 4
+ ,XmmReg 4 l w
#endif
#if defined(REG_YMM4)
,YmmReg 4
@@ -559,7 +559,7 @@ activeStgRegs = [
,DoubleReg 5
#endif
#if defined(REG_XMM5)
- ,XmmReg 5
+ ,XmmReg 5 l w
#endif
#if defined(REG_YMM5)
,YmmReg 5
@@ -574,7 +574,7 @@ activeStgRegs = [
,DoubleReg 6
#endif
#if defined(REG_XMM6)
- ,XmmReg 6
+ ,XmmReg 6 l w
#endif
#if defined(REG_YMM6)
,YmmReg 6
@@ -737,22 +737,22 @@ globalRegMaybe (DoubleReg 6) =
# endif
# if MAX_REAL_XMM_REG != 0
# if defined(REG_XMM1)
-globalRegMaybe (XmmReg 1) = Just (RealRegSingle REG_XMM1)
+globalRegMaybe (XmmReg 1 _ _) = Just (RealRegSingle REG_XMM1)
# endif
# if defined(REG_XMM2)
-globalRegMaybe (XmmReg 2) = Just (RealRegSingle REG_XMM2)
+globalRegMaybe (XmmReg 2 _ _) = Just (RealRegSingle REG_XMM2)
# endif
# if defined(REG_XMM3)
-globalRegMaybe (XmmReg 3) = Just (RealRegSingle REG_XMM3)
+globalRegMaybe (XmmReg 3 _ _) = Just (RealRegSingle REG_XMM3)
# endif
# if defined(REG_XMM4)
-globalRegMaybe (XmmReg 4) = Just (RealRegSingle REG_XMM4)
+globalRegMaybe (XmmReg 4 _ _) = Just (RealRegSingle REG_XMM4)
# endif
# if defined(REG_XMM5)
-globalRegMaybe (XmmReg 5) = Just (RealRegSingle REG_XMM5)
+globalRegMaybe (XmmReg 5 _ _) = Just (RealRegSingle REG_XMM5)
# endif
# if defined(REG_XMM6)
-globalRegMaybe (XmmReg 6) = Just (RealRegSingle REG_XMM6)
+globalRegMaybe (XmmReg 6 _ _) = Just (RealRegSingle REG_XMM6)
# endif
# endif
# if defined(MAX_REAL_YMM_REG) && MAX_REAL_YMM_REG != 0
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment