summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2019-12-26 14:31:33 -0500
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-12-30 06:52:45 -0500
commitb426de376e278af5fb7a8ce0ef7b1e245847c662 (patch)
treeafb7c6e9661e20d5ba02c803fb55cacb776207ca /compiler
parentf14bb50b76a60253a090797c652a9d29120bf875 (diff)
downloadhaskell-b426de376e278af5fb7a8ce0ef7b1e245847c662.tar.gz
llvmGen: Ensure that entry labels don't have predecessors
The LLVM IR forbids the entry label of a procedure from having any predecessors. In the case of a simple looping function the LLVM code generator broke this invariant, as noted in #17589. Fix this by moving the function prologue to its own basic block, as suggested by @kavon in #11649. Fixes #11649 and #17589.
Diffstat (limited to 'compiler')
-rw-r--r--compiler/llvmGen/LlvmCodeGen/CodeGen.hs21
1 files changed, 14 insertions, 7 deletions
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index c8d88a8c2a..0e907fc0eb 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -66,20 +66,24 @@ genLlvmProc _ = panic "genLlvmProc: case that shouldn't reach here!"
-- | Generate code for a list of blocks that make up a complete
-- procedure. The first block in the list is expected to be the entry
--- point and will get the prologue.
+-- point.
basicBlocksCodeGen :: LiveGlobalRegs -> [CmmBlock]
-> LlvmM ([LlvmBasicBlock], [LlvmCmmDecl])
basicBlocksCodeGen _ [] = panic "no entry block!"
-basicBlocksCodeGen live (entryBlock:cmmBlocks)
- = do (prologue, prologueTops) <- funPrologue live (entryBlock:cmmBlocks)
+basicBlocksCodeGen live cmmBlocks
+ = do -- Emit the prologue
+ -- N.B. this must be its own block to ensure that the entry block of the
+ -- procedure has no predecessors, as required by the LLVM IR. See #17589
+ -- and #11649.
+ bid <- newBlockId
+ (prologue, prologueTops) <- funPrologue live cmmBlocks
+ let entryBlock = BasicBlock bid (fromOL prologue)
-- Generate code
- (BasicBlock bid entry, entryTops) <- basicBlockCodeGen entryBlock
(blocks, topss) <- fmap unzip $ mapM basicBlockCodeGen cmmBlocks
-- Compose
- let entryBlock = BasicBlock bid (fromOL prologue ++ entry)
- return (entryBlock : blocks, prologueTops ++ entryTops ++ concat topss)
+ return (entryBlock : blocks, prologueTops ++ concat topss)
-- | Generate code for one block
@@ -1834,7 +1838,10 @@ funPrologue live cmmBlocks = do
markStackReg r
return $ toOL [alloc, Store rval reg]
- return (concatOL stmtss, [])
+ return (concatOL stmtss `snocOL` jumpToEntry, [])
+ where
+ entryBlk : _ = cmmBlocks
+ jumpToEntry = Branch $ blockIdToLlvm (entryLabel entryBlk)
-- | Function epilogue. Load STG variables to use as argument for call.
-- STG Liveness optimisation done here.