[commit: ghc] wip/kavon-nosplit-llvm: nofib's queens works fine now! (14d0045)

[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/14d00455f98f269374f57f6047005972af1c42fe/ghc

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

commit 14d00455f98f269374f57f6047005972af1c42fe
Author: Kavon Farvardin <kavon at farvard.in>
Date:   Wed Jun 7 17:24:34 2017 +0100

    nofib's queens works fine now!


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

14d00455f98f269374f57f6047005972af1c42fe
 compiler/llvmGen/LlvmCodeGen/Base.hs    | 8 ++++++--
 compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 2 +-
 compiler/llvmGen/LlvmCodeGen/Ppr.hs     | 2 +-
 3 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 08c2d60..d34aaed 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, llvmStdConv,
+        llvmPtrBits, tysToParams, llvmFunSection, llvmStdConv, llvmStdFunDefAttrs,
 
         strCLabel_llvm, strDisplayName_llvm, strProcedureName_llvm,
         getGlobalPtr, generateExternDecls,
@@ -166,10 +166,14 @@ llvmFunArgs dflags live =
     map (lmGlobalRegArg dflags) (llvmStdConv dflags live)
     
 
--- | Llvm standard fun attributes
+-- | Llvm standard function call attributes
 llvmStdFunAttrs :: [LlvmFuncAttr]
 llvmStdFunAttrs = [NoUnwind]
 
+-- | Llvm standard function definition attributes
+llvmStdFunDefAttrs :: [LlvmFuncAttr]
+llvmStdFunDefAttrs = [NoUnwind, Naked]
+
 -- | Convert a list of types to a list of function parameters
 -- (each with no parameter attributes)
 tysToParams :: [LlvmType] -> [LlvmParameter]
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index 4b8d4ae..eee57a3 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -445,7 +445,7 @@ genCall target res args = runStmtsDecls $ do
     fptr    <- getFunPtrW funTy target
 
     let doReturn | ccTy == TailCall  = statement $ Return Nothing
-                 | never_returns     = statement $ Unreachable
+                 | never_returns     = statement $ Unreachable  -- TODO(kavon): this breaks TCO
                  | otherwise         = return ()
 
     doTrashStmts
diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
index 8b6340d..52c7c4f 100644
--- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
@@ -129,7 +129,7 @@ pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks))
                        return $ Just $ LMStaticStruc infoStatics infoTy
 
 
-       let fun = LlvmFunction funDec funArgs llvmStdFunAttrs funSect
+       let fun = LlvmFunction funDec funArgs llvmStdFunDefAttrs funSect
                               prefix lmblocks
            name = decName $ funcDecl fun
            defName = name `appendFS` fsLit "$def"