[commit: ghc] wip/kavon-llvm-improve: fix issue in patch for T14251; missed an increment (0a4d1fe)

git at git.haskell.org git at git.haskell.org
Fri Sep 28 15:02:53 UTC 2018


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

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

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

commit 0a4d1fefc53c87ee1dceab37568d6ed3587967a5
Author: Kavon Farvardin <kavon at farvard.in>
Date:   Fri Sep 28 10:02:23 2018 -0500

    fix issue in patch for T14251; missed an increment


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

0a4d1fefc53c87ee1dceab37568d6ed3587967a5
 compiler/llvmGen/LlvmCodeGen/Base.hs | 17 +++++++++--------
 1 file changed, 9 insertions(+), 8 deletions(-)

diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 0e3e1b9..f80705e 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -152,7 +152,7 @@ llvmFunArgs dflags live =
     where platform = targetPlatform dflags
           allRegs = sortSSERegs $ activeStgRegs platform
           paddedLive = map (\(_,r) -> r) $ padLiveArgs live
-          isLive r = not (isSSE r) || r `elem` alwaysLive || r `elem` paddedLive
+          isLive r = r `elem` alwaysLive || r `elem` paddedLive
           isPassed r = not (isSSE r) || isLive r
           isSSE r
             | Just _ <- sseRegNum r = True
@@ -181,29 +181,30 @@ sortSSERegs regs = sortBy sseOrd regs
 -- assumes that the live list is sorted by Ord GlobalReg's compare function.
 -- the bool indicates whether the global reg was added as padding.
 padLiveArgs :: LiveGlobalRegs -> [(Bool, GlobalReg)]
-padLiveArgs live = reverse padded
+padLiveArgs live = padded
     where
         (_, padded) = foldl assignSlots (1, []) $ sortSSERegs live
 
         assignSlots (i, acc) r
             | Just k <- sseRegNum r
             , i < k
-            = let  -- add k-i slots of padding
+            = let  -- add k-i slots of padding before the register
                 diff = 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')
 
-            | otherwise = (i, (False, r):acc)
+            | otherwise = (i+1, (False, r):acc)
 
         genPad start n =
             take n $ flip map (iterate (+1) start) (\i ->
                 (True, FloatReg i))
-                -- FIXME: perhaps we should obtain the original type,
-                -- instead of just picking Float here? It should be fine
-                -- since this argument is not live anyways,
-                -- and Float aliases with all the other F/D regs.
+                -- 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



More information about the ghc-commits mailing list