[commit: ghc] wip/kavon-llvm-improve: rewrote patch for T14619 to fix a lingering bug, and make it clearer (e778fee)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/kavon-llvm-improve
Link       : http://ghc.haskell.org/trac/ghc/changeset/e778fee5d69fca669ca6d54a67966590aac130f0/ghc

>---------------------------------------------------------------

commit e778fee5d69fca669ca6d54a67966590aac130f0
Author: Kavon Farvardin <kavon at farvard.in>
Date:   Sat Sep 29 19:27:07 2018 -0500

    rewrote patch for T14619 to fix a lingering bug, and make it clearer


>---------------------------------------------------------------

e778fee5d69fca669ca6d54a67966590aac130f0
 compiler/llvmGen/LlvmCodeGen/Base.hs    | 61 ++++++++++++++-------------------
 compiler/llvmGen/LlvmCodeGen/CodeGen.hs |  9 +----
 2 files changed, 26 insertions(+), 44 deletions(-)

diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 15629a4..d4ae43a 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, sortSSERegs,
+        llvmPtrBits, tysToParams, llvmFunSection, padLiveArgs, isSSE,
 
         strCLabel_llvm, strDisplayName_llvm, strProcedureName_llvm,
         getGlobalPtr, generateExternDecls,
@@ -58,8 +58,8 @@ import ErrUtils
 import qualified Stream
 
 import Control.Monad (ap)
-import Data.List (sortBy, partition)
-import Data.Maybe (isJust)
+import Data.List (sort, partition)
+import Data.Maybe (mapMaybe)
 
 -- ----------------------------------------------------------------------------
 -- * Some Data Types
@@ -151,7 +151,7 @@ llvmFunArgs :: DynFlags -> LiveGlobalRegs -> [LlvmVar]
 llvmFunArgs dflags live =
     map (lmGlobalRegArg dflags) (filter isPassed allRegs)
     where platform = targetPlatform dflags
-          allRegs = sortSSERegs $ activeStgRegs platform
+          allRegs = activeStgRegs platform
           paddedLive = map (\(_,r) -> r) $ padLiveArgs live
           isLive r = r `elem` alwaysLive || r `elem` paddedLive
           isPassed r = not (isSSE r) || isLive r
@@ -160,6 +160,14 @@ llvmFunArgs dflags live =
             | otherwise = False
 
 
+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
@@ -168,44 +176,25 @@ sseRegNum (YmmReg i)    = Just i
 sseRegNum (ZmmReg i)    = Just i
 sseRegNum _             = Nothing
 
--- Only sorts regs that will end up in SSE registers
--- such that the ones which are assigned to the same
--- register will be adjacent in the list. Other elements
--- are not reordered.
-sortSSERegs :: [GlobalReg] -> [GlobalReg]
-sortSSERegs regs = sortBy sseOrd regs
-    where
-        sseOrd a b = case (sseRegNum a, sseRegNum b) of
-            (Just x, Just y) -> compare x y
-            _                 -> EQ
-
 -- 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
-        (sse, others) = partition (isJust . sseRegNum) live
-        (_, padded) = foldl assignSlots (1, []) $ sortSSERegs sse
-        allRegs = padded ++ map (\r -> (False, r)) others
-
-        assignSlots (i, acc) r
-            | Just k <- sseRegNum r =
-              if i == k
-                then -- don't need padding
-                    (i+1, (False, r):acc)
-                else let  -- add k-i slots of padding before the register
-                      diff = if i > k
-                              then error "padLiveArgs -- index should not be greater!"
-                              else k-i
-
-                      -- NOTE: order doesn't matter in acc, since it's like a set
-                      acc' = genPad i diff ++ (False, r) : acc
-                      i' = i + diff
-                    in
-                      (i', acc')
-            -- not an SSE reg, so just keep going
-            | otherwise = (i, (False, r):acc)
+        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
+                  (i+1, acc)
+            | i < regNum = let -- add padding for slots i .. regNum-1
+                  numNeeded = regNum-i
+                  acc' = genPad i numNeeded ++ acc
+                in
+                  (regNum+1, acc')
+            | otherwise = error "padLiveArgs -- i > regNum ??"
 
         genPad start n =
             take n $ flip map (iterate (+1) start) (\i ->
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index 9159493..1873400 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -1819,13 +1819,6 @@ funEpilogue live = do
     let alwaysNeeded = map (\r -> (False, r)) alwaysLive
         livePadded = alwaysNeeded ++ padLiveArgs live
 
-        isSSE (FloatReg _)  = True
-        isSSE (DoubleReg _) = True
-        isSSE (XmmReg _)    = True
-        isSSE (YmmReg _)    = True
-        isSSE (ZmmReg _)    = True
-        isSSE _             = False
-
     -- Set to value or "undef" depending on whether the register is
     -- actually live
     dflags <- getDynFlags
@@ -1836,7 +1829,7 @@ funEpilogue live = do
           let ty = (pLower . getVarType $ lmGlobalRegVar dflags r)
           return (Just $ LMLitVar $ LMUndefLit ty, nilOL)
     platform <- getDynFlag targetPlatform
-    let allRegs = sortSSERegs $ activeStgRegs platform
+    let allRegs = activeStgRegs platform
     loads <- flip mapM allRegs $ \r -> case () of
       _ | (False, r) `elem` livePadded
                              -> loadExpr r   -- if r is not padding, load it