diff options
| -rw-r--r-- | compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 21 |
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. |