Fix #6158. LLVM 3.1 doesn't like certain constructions that 3.0 and

earlier did, so we avoid them.

1 files changed, 15 insertions, 3 deletions

diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index e9d8ac52a8..79a0c00543 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -202,11 +202,12 @@ genCall env t@(CmmPrim (MO_PopCnt w) _) [CmmHinted dst _] args _ = do
 
 -- Handle memcpy function specifically since llvm's intrinsic version takes
 -- some extra parameters.
-genCall env t@(CmmPrim op _) [] args CmmMayReturn
+genCall env t@(CmmPrim op _) [] args' CmmMayReturn
  | op == MO_Memcpy ||
    op == MO_Memset ||
    op == MO_Memmove = do
-    let (isVolTy, isVolVal) = if getLlvmVer env >= 28
+    let (args, alignVal) = splitAlignVal args'
+        (isVolTy, isVolVal) = if getLlvmVer env >= 28
                                  then ([i1], [mkIntLit i1 0]) else ([], [])
         argTy | op == MO_Memset = [i8Ptr, i8,    llvmWord, i32] ++ isVolTy
               | otherwise       = [i8Ptr, i8Ptr, llvmWord, i32] ++ isVolTy
@@ -217,11 +218,22 @@ genCall env t@(CmmPrim op _) [] args CmmMayReturn
     (env2, fptr, stmts2, top2)    <- getFunPtr env1 funTy t
     (argVars', stmts3)            <- castVars $ zip argVars argTy
 
-    let arguments = argVars' ++ isVolVal
+    let arguments = argVars' ++ (alignVal:isVolVal)
         call = Expr $ Call StdCall fptr arguments []
         stmts = stmts1 `appOL` stmts2 `appOL` stmts3
                 `appOL` trashStmts `snocOL` call
     return (env2, stmts, top1 ++ top2)
+  
+  where
+    splitAlignVal xs = (init xs, extractLit $ last xs)
+
+    -- Fix for trac #6158. Since LLVM 3.1, opt fails when given anything other
+    -- than a direct constant (i.e. 'i32 8') as the alignment argument for the
+    -- memcpy & co llvm intrinsic functions. So we handle this directly now.
+    extractLit (CmmHinted (CmmLit (CmmInt i _)) _) = mkIntLit i32 i
+    extractLit _other = trace ("WARNING: Non constant alignment value given" ++ 
+                               " for memcpy! Please report to GHC developers")
+                        mkIntLit i32 0
 
 genCall env (CmmPrim _ (Just stmts)) _ _ _
     = stmtsToInstrs env stmts (nilOL, [])