[commit: ghc] wip/kavon-nosplit-llvm: partial fix for type error with SSE reg values (5994a51)

[git at git.haskell.org]

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

On branch  : wip/kavon-nosplit-llvm
Link       : http://ghc.haskell.org/trac/ghc/changeset/5994a511c8ae406c09c2d7c95b75344de4b5292c/ghc

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

commit 5994a511c8ae406c09c2d7c95b75344de4b5292c
Author: Kavon Farvardin <kavon at farvard.in>
Date:   Fri Jun 9 17:35:52 2017 +0100

    partial fix for type error with SSE reg values


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

5994a511c8ae406c09c2d7c95b75344de4b5292c
 compiler/llvmGen/LlvmCodeGen/Base.hs    | 42 +++++++++++++++++++++++----------
 compiler/llvmGen/LlvmCodeGen/CodeGen.hs |  5 ++--
 2 files changed, 33 insertions(+), 14 deletions(-)

diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index d34aaed..14e9ca2 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -27,6 +27,7 @@ module LlvmCodeGen.Base (
         cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy,
         llvmFunSig, llvmFunArgs, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign,
         llvmPtrBits, tysToParams, llvmFunSection, llvmStdConv, llvmStdFunDefAttrs,
+        llvmStdRetConv,
 
         strCLabel_llvm, strDisplayName_llvm, strProcedureName_llvm,
         getGlobalPtr, generateExternDecls,
@@ -125,10 +126,13 @@ llvmFunSig' live lbl link
                       | otherwise   = (x, [])
        dflags <- getDynFlags
        -- the standard set of argument types passed/returned.
-       let stdConvention = map getVarType (llvmFunArgs dflags live)
-       let retTy = LMStructU $ stdConvention -- TODO(kavon): introduce a type alias to reduce bytes output
+       let regToTy = getVarType . (lmGlobalRegArg dflags)
+           callConv = map getVarType (llvmFunArgs dflags live)
+           retConv = map regToTy (llvmStdRetConv dflags)
+       -- TODO(kavon): introduce a type alias for the ret struct to reduce bytes output
+           retTy = LMStructU $ retConv
        return $ LlvmFunctionDecl lbl link (llvmGhcCC dflags) retTy FixedArgs
-                                 (map toParams stdConvention)
+                                 (map toParams callConv)
                                  (llvmFunAlign dflags)
 
 -- | Alignment to use for functions
@@ -146,19 +150,33 @@ llvmFunSection dflags lbl
     | otherwise                     = Nothing
 
 -- | The full set of Cmm registers passed to a function, in the correct order,
---   given the live argument registers. This is used for both call and return.
+--   given the live argument registers.
 llvmStdConv :: DynFlags -> LiveGlobalRegs -> [GlobalReg]
 llvmStdConv dflags live = 
     filter isPassed (activeStgRegs 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 (YmmReg _)    = True
-          isSSE (ZmmReg _)    = True
-          isSSE _             = False
+          isLive r = r `elem` alwaysLive || r `elem` live
+          isPassed r = not (isFloatReg r || isVectorReg r) || isLive r
+          
+-- | The full set of Cmm registers returned from a function, in the correct order.
+llvmStdRetConv :: DynFlags -> [GlobalReg]
+llvmStdRetConv dflags = 
+    -- NB: the return type of all LLVM fuctions must match up for tail-call optimization,
+    --     so we pick a safe superset of all return types here.
+    filter isPassed (activeStgRegs platform)
+    where platform = targetPlatform dflags
+          isPassed r = not $ isVectorReg r -- TODO(kavon): I see no reason why we can't return a vector reg
+          
+isFloatReg :: GlobalReg -> Bool
+isFloatReg (FloatReg _)  = True
+isFloatReg (DoubleReg _) = True
+isFloatReg _             = False
+          
+isVectorReg :: GlobalReg -> Bool
+isVectorReg (XmmReg _) = True
+isVectorReg (YmmReg _) = True
+isVectorReg (ZmmReg _) = True
+isVectorReg _          = False
 
 -- | A Function's arguments
 llvmFunArgs :: DynFlags -> LiveGlobalRegs -> [LlvmVar]
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index eee57a3..ab09516 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -865,8 +865,9 @@ doReturnTo (retl, _, retArgs) llRetV = do
         -- we could avoid emitting those extracts by slimming down the retRegs list.
         
         -- retRegs is a subset of allRegs, with the _same relative ordering_
-        retRegs = llvmStdConv dflags retArgs
-        allRegs = activeStgRegs $ targetPlatform dflags
+        allRegs = llvmStdRetConv dflags
+        isPassed r = r `elem` retArgs || r `elem` alwaysLive
+        retRegs = filter isPassed allRegs
         
         extract (z@(_, [], _)) _ = return z -- no more slots needed
         extract (i, x:xs, stms) reg