Commit 92821ec9 authored by Erik de Castro Lopo's avatar Erik de Castro Lopo Committed by Ben Gamari

LlvmCodeGen: Fix generation of malformed LLVM blocks

Commit 673efccb 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
parent 41051dd8
......@@ -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@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])
......
{-# 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
......@@ -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, [''])
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment