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.

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.