Revert "Fix for T14251 on ARM"

This reverts commit d8495549ba9d194815c2d0eaee6797fc7c00756a.

2 files changed, 39 insertions, 90 deletions

diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 0a40b73766..ec91bacc4c 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -26,7 +26,7 @@ module LlvmCodeGen.Base (
 
         cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy,
         llvmFunSig, llvmFunArgs, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign,
-        llvmPtrBits, tysToParams, llvmFunSection, padLiveArgs, isFPR,
+        llvmPtrBits, tysToParams, llvmFunSection, padLiveArgs, isSSE,
 
         strCLabel_llvm, strDisplayName_llvm, strProcedureName_llvm,
         getGlobalPtr, generateExternDecls,
@@ -47,7 +47,6 @@ import CodeGen.Platform ( activeStgRegs )
 import DynFlags
 import FastString
 import Cmm              hiding ( succ )
-import CmmUtils ( regsOverlap )
 import Outputable as Outp
 import Platform
 import UniqFM
@@ -59,7 +58,8 @@ import ErrUtils
 import qualified Stream
 
 import Control.Monad (ap)
-import Data.List (sort, groupBy, head)
+import Data.List (sort)
+import Data.Maybe (mapMaybe)
 
 -- ----------------------------------------------------------------------------
 -- * Some Data Types
@@ -152,91 +152,36 @@ llvmFunArgs dflags live =
     map (lmGlobalRegArg dflags) (filter isPassed allRegs)
     where platform = targetPlatform dflags
           allRegs = activeStgRegs platform
-          paddedLive = map (\(_,r) -> r) $ padLiveArgs dflags live
+          paddedLive = map (\(_,r) -> r) $ padLiveArgs live
           isLive r = r `elem` alwaysLive || r `elem` paddedLive
-          isPassed r = not (isFPR r) || isLive r
-
-
-isFPR :: GlobalReg -> Bool
-isFPR (FloatReg _)  = True
-isFPR (DoubleReg _) = True
-isFPR (XmmReg _)    = True
-isFPR (YmmReg _)    = True
-isFPR (ZmmReg _)    = True
-isFPR _             = False
-
-sameFPRClass :: GlobalReg -> GlobalReg -> Bool
-sameFPRClass (FloatReg _)  (FloatReg _) = True
-sameFPRClass (DoubleReg _) (DoubleReg _) = True
-sameFPRClass (XmmReg _)    (XmmReg _) = True
-sameFPRClass (YmmReg _)    (YmmReg _) = True
-sameFPRClass (ZmmReg _)    (ZmmReg _) = True
-sameFPRClass _             _          = False
-
-normalizeFPRNum :: GlobalReg -> GlobalReg
-normalizeFPRNum (FloatReg _)  = FloatReg 1
-normalizeFPRNum (DoubleReg _) = DoubleReg 1
-normalizeFPRNum (XmmReg _)    = XmmReg 1
-normalizeFPRNum (YmmReg _)    = YmmReg 1
-normalizeFPRNum (ZmmReg _)    = ZmmReg 1
-normalizeFPRNum _ = error "normalizeFPRNum expected only FPR regs"
-
-getFPRCtor :: GlobalReg -> Int -> GlobalReg
-getFPRCtor (FloatReg _)  = FloatReg
-getFPRCtor (DoubleReg _) = DoubleReg
-getFPRCtor (XmmReg _)    = XmmReg
-getFPRCtor (YmmReg _)    = YmmReg
-getFPRCtor (ZmmReg _)    = ZmmReg
-getFPRCtor _ = error "getFPRCtor expected only FPR regs"
-
-fprRegNum :: GlobalReg -> Int
-fprRegNum (FloatReg i)  = i
-fprRegNum (DoubleReg i) = i
-fprRegNum (XmmReg i)    = i
-fprRegNum (YmmReg i)    = i
-fprRegNum (ZmmReg i)    = i
-fprRegNum _ = error "fprRegNum expected only FPR regs"
-
--- | Input: dynflags, and the list of live registers
---
--- Output: An augmented list of live registers, where padding was
--- added to the list of registers to ensure the calling convention is
--- correctly used by LLVM.
---
--- Each global reg in the returned list is tagged with a bool, which
--- indicates whether the global reg was added as padding, or was an original
--- live register.
---
--- That is, True => padding, False => a real, live global register.
---
--- Also, the returned list is not sorted in any particular order.
---
-padLiveArgs :: DynFlags -> LiveGlobalRegs -> [(Bool, GlobalReg)]
-padLiveArgs dflags live =
-      if platformUnregisterised plat
-        then taggedLive -- not using GHC's register convention for platform.
-        else padding ++ taggedLive
-  where
-    taggedLive = map (\x -> (False, x)) live
-    plat = targetPlatform dflags
-
-    fprLive = filter isFPR live
-    padding = concatMap calcPad $ groupBy sharesClass fprLive
-
-    sharesClass :: GlobalReg -> GlobalReg -> Bool
-    sharesClass a b = sameFPRClass a b || overlappingClass
-      where
-        overlappingClass = regsOverlap dflags (norm a) (norm b)
-        norm = CmmGlobal . normalizeFPRNum
-
-    calcPad :: [GlobalReg] -> [(Bool, GlobalReg)]
-    calcPad rs = getFPRPadding (getFPRCtor $ head rs) rs
-
-getFPRPadding :: (Int -> GlobalReg) -> LiveGlobalRegs -> [(Bool, GlobalReg)]
-getFPRPadding paddingCtor live = padding
+          isPassed r = not (isSSE r) || isLive r
+
+
+isSSE :: GlobalReg -> Bool
+isSSE (FloatReg _)  = True
+isSSE (DoubleReg _) = True
+isSSE (XmmReg _)    = True
+isSSE (YmmReg _)    = True
+isSSE (ZmmReg _)    = True
+isSSE _             = False
+
+sseRegNum :: GlobalReg -> Maybe Int
+sseRegNum (FloatReg i)  = Just i
+sseRegNum (DoubleReg i) = Just i
+sseRegNum (XmmReg i)    = Just i
+sseRegNum (YmmReg i)    = Just i
+sseRegNum (ZmmReg i)    = Just i
+sseRegNum _             = Nothing
+
+-- the bool indicates whether the global reg was added as padding.
+-- the returned list is not sorted in any particular order,
+-- but does indicate the set of live registers needed, with SSE padding.
+padLiveArgs :: LiveGlobalRegs -> [(Bool, GlobalReg)]
+padLiveArgs live = allRegs
     where
-        fprRegNums = sort $ map fprRegNum live
-        (_, padding) = foldl assignSlots (1, []) $ fprRegNums
+        sseRegNums = sort $ mapMaybe sseRegNum live
+        (_, padding) = foldl assignSlots (1, []) $ sseRegNums
+        allRegs = padding ++ map (\r -> (False, r)) live
 
         assignSlots (i, acc) regNum
             | i == regNum = -- don't need padding here
@@ -250,7 +195,11 @@ getFPRPadding paddingCtor live = padding
 
         genPad start n =
             take n $ flip map (iterate (+1) start) (\i ->
-                (True, paddingCtor i))
+                (True, FloatReg i))
+                -- NOTE: Picking float should be fine for the following reasons:
+                -- (1) Float aliases with all the other SSE register types on
+                -- the given platform.
+                -- (2) The argument is not live anyways.
 
 
 -- | Llvm standard fun attributes
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index d24075ec7c..de839fbdeb 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -1818,14 +1818,14 @@ funPrologue live cmmBlocks = do
 -- STG Liveness optimisation done here.
 funEpilogue :: LiveGlobalRegs -> LlvmM ([LlvmVar], LlvmStatements)
 funEpilogue live = do
-    dflags <- getDynFlags
 
     -- the bool indicates whether the register is padding.
     let alwaysNeeded = map (\r -> (False, r)) alwaysLive
-        livePadded = alwaysNeeded ++ padLiveArgs dflags live
+        livePadded = alwaysNeeded ++ padLiveArgs live
 
     -- Set to value or "undef" depending on whether the register is
     -- actually live
+    dflags <- getDynFlags
     let loadExpr r = do
           (v, _, s) <- getCmmRegVal (CmmGlobal r)
           return (Just $ v, s)
@@ -1837,7 +1837,7 @@ funEpilogue live = do
     loads <- flip mapM allRegs $ \r -> case () of
       _ | (False, r) `elem` livePadded
                              -> loadExpr r   -- if r is not padding, load it
-        | not (isFPR r) || (True, r) `elem` livePadded
+        | not (isSSE r) || (True, r) `elem` livePadded
                              -> loadUndef r
         | otherwise          -> return (Nothing, nilOL)