[commit: ghc] ghc-8.0: LlvmCodeGen: Fix generation of malformed LLVM blocks (1e7764c)
git at git.haskell.org
git at git.haskell.org
Sat Mar 12 21:45:44 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-8.0
Link : http://ghc.haskell.org/trac/ghc/changeset/1e7764ce888708cb46dc74a036af92b550bc85eb/ghc
>---------------------------------------------------------------
commit 1e7764ce888708cb46dc74a036af92b550bc85eb
Author: Erik de Castro Lopo <erikd at mega-nerd.com>
Date: Sat Mar 12 12:03:56 2016 +0100
LlvmCodeGen: Fix generation of malformed LLVM blocks
Commit 673efccb3b uncovered a bug in LLVM code generation that produced
LLVM code that the LLVM compiler refused to compile:
{
clpH:
br label %clpH
}
This may well be a bug in LLVM itself. The solution is to keep the
existing entry label and rewrite the function as:
{
clpH:
br label %nPV
nPV:
br label %nPV
}
Thanks to Ben Gamari for pointing me in the right direction on this
one.
Test Plan: Build GHC with BuildFlavour=quick-llvm
Reviewers: hvr, austin, bgamari
Reviewed By: bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D1996
GHC Trac Issues: #11649
(cherry picked from commit 92821ec9a57817e1429ae94c756539259488b728)
>---------------------------------------------------------------
1e7764ce888708cb46dc74a036af92b550bc85eb
compiler/llvmGen/LlvmCodeGen.hs | 34 ++++++++++++++++++++++++++-
testsuite/tests/llvm/should_compile/T11649.hs | 16 +++++++++++++
testsuite/tests/llvm/should_compile/all.T | 1 +
3 files changed, 50 insertions(+), 1 deletion(-)
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
index 3c63aa0..872ad8c 100644
--- a/compiler/llvmGen/LlvmCodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen.hs
@@ -15,8 +15,10 @@ import LlvmCodeGen.Ppr
import LlvmCodeGen.Regs
import LlvmMangler
+import BlockId
import CgUtils ( fixStgRegisters )
import Cmm
+import CmmUtils
import Hoopl
import PprCmm
@@ -120,13 +122,43 @@ cmmDataLlvmGens statics
renderLlvm $ pprLlvmData (concat gss', concat tss)
+-- | LLVM can't handle entry blocks which loop back to themselves (could be
+-- seen as an LLVM bug) so we rearrange the code to keep the original entry
+-- label which branches to a newly generated second label that branches back
+-- to itself. See: Trac #11649
+fixBottom :: RawCmmDecl -> LlvmM RawCmmDecl
+fixBottom cp@(CmmProc hdr entry_lbl live g) =
+ maybe (pure cp) fix_block $ mapLookup (g_entry g) blk_map
+ where
+ blk_map = toBlockMap g
+
+ fix_block :: CmmBlock -> LlvmM RawCmmDecl
+ fix_block blk
+ | (CmmEntry e_lbl tickscp, middle, CmmBranch b_lbl) <- blockSplit blk
+ , isEmptyBlock middle
+ , e_lbl == b_lbl = do
+ new_lbl <- mkBlockId <$> getUniqueM
+
+ let fst_blk =
+ BlockCC (CmmEntry e_lbl tickscp) BNil (CmmBranch new_lbl)
+ snd_blk =
+ BlockCC (CmmEntry new_lbl tickscp) BNil (CmmBranch new_lbl)
+
+ pure . CmmProc hdr entry_lbl live . ofBlockMap (g_entry g)
+ $ mapFromList [(e_lbl, fst_blk), (new_lbl, snd_blk)]
+
+ fix_block _ = pure cp
+
+fixBottom rcd = pure rcd
+
-- | Complete LLVM code generation phase for a single top-level chunk of Cmm.
cmmLlvmGen ::RawCmmDecl -> LlvmM ()
cmmLlvmGen cmm at CmmProc{} = do
-- rewrite assignments to global regs
dflags <- getDynFlag id
- let fixed_cmm = {-# SCC "llvm_fix_regs" #-}
+ fixed_cmm <- fixBottom $
+ {-# SCC "llvm_fix_regs" #-}
fixStgRegisters dflags cmm
dumpIfSetLlvm Opt_D_dump_opt_cmm "Optimised Cmm" (pprCmmGroup [fixed_cmm])
diff --git a/testsuite/tests/llvm/should_compile/T11649.hs b/testsuite/tests/llvm/should_compile/T11649.hs
new file mode 100644
index 0000000..9d09c3a
--- /dev/null
+++ b/testsuite/tests/llvm/should_compile/T11649.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module Test where
+import GHC.Base
+
+data U1 p = U1
+
+instance Functor U1 where
+ fmap f U1 = U1
+
+instance Applicative U1 where
+ pure _ = U1
+ U1 <*> U1 = U1
+
+instance Alternative U1 where
+ empty = U1
+ U1 <|> U1 = U1
diff --git a/testsuite/tests/llvm/should_compile/all.T b/testsuite/tests/llvm/should_compile/all.T
index 9da136d..6806c25 100644
--- a/testsuite/tests/llvm/should_compile/all.T
+++ b/testsuite/tests/llvm/should_compile/all.T
@@ -13,3 +13,4 @@ test('T6158', [reqlib('vector'), reqlib('primitive')], compile, ['-package vecto
test('T7571', cmm_src, compile, [''])
test('T7575', unless(wordsize(32), skip), compile, [''])
test('T8131b', normal, compile, [''])
+test('T11649', normal, compile, [''])
More information about the ghc-commits
mailing list