diff options
author | Cheng Shao <terrorjack@type.dance> | 2023-04-07 18:39:59 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-04-11 19:25:31 -0400 |
commit | 05d26a650b6e9e1169b42376fe54bb00850722f2 (patch) | |
tree | cad24aef8cae27d1d0ab46092df1480250aec4af | |
parent | 6c3926167dc6c2978531ecac06e1eda50874297a (diff) | |
download | haskell-05d26a650b6e9e1169b42376fe54bb00850722f2.tar.gz |
compiler: apply cmm node-splitting for wasm backend
This patch applies cmm node-splitting for wasm32 NCG, which is
required when handling irreducible CFGs. Fixes #23237.
-rw-r--r-- | compiler/GHC/CmmToAsm/Wasm/FromCmm.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Wasm/ControlFlow/FromCmm.hs | 11 |
2 files changed, 10 insertions, 3 deletions
diff --git a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs index db4b39f756..7ca323d72d 100644 --- a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs +++ b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs @@ -1529,9 +1529,11 @@ lower_CmmGraph :: CLabel -> CmmGraph -> WasmCodeGenM w (FuncBody w) lower_CmmGraph lbl g = do ty_word <- wasmWordTypeM platform <- wasmPlatformM + us <- getUniqueSupplyM body <- structuredControl platform + us (\_ -> lower_CmmExpr_Typed lbl ty_word) (lower_CmmActions lbl) g diff --git a/compiler/GHC/Wasm/ControlFlow/FromCmm.hs b/compiler/GHC/Wasm/ControlFlow/FromCmm.hs index 85eb8e534b..b0449aaedc 100644 --- a/compiler/GHC/Wasm/ControlFlow/FromCmm.hs +++ b/compiler/GHC/Wasm/ControlFlow/FromCmm.hs @@ -19,12 +19,13 @@ import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dominators import GHC.Cmm.Dataflow.Graph import GHC.Cmm.Dataflow.Label +import GHC.Cmm.Reducibility import GHC.Cmm.Switch import GHC.CmmToAsm.Wasm.Types import GHC.Platform - +import GHC.Types.Unique.Supply import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Utils.Outputable ( Outputable, text, (<+>), ppr @@ -140,15 +141,19 @@ emptyPost _ = False structuredControl :: forall expr stmt m . Applicative m => Platform -- ^ needed for offset calculation + -> UniqSupply -> (Label -> CmmExpr -> m expr) -- ^ translator for expressions -> (Label -> CmmActions -> m stmt) -- ^ translator for straight-line code -> CmmGraph -- ^ CFG to be translated -> m (WasmControl stmt expr '[] '[ 'I32]) -structuredControl platform txExpr txBlock g = +structuredControl platform us txExpr txBlock g' = doTree returns dominatorTree emptyContext where + g :: CmmGraph + g = gwd_graph gwd + gwd :: GraphWithDominators CmmNode - gwd = graphWithDominators g + gwd = initUs_ us $ asReducible $ graphWithDominators g' dominatorTree :: Tree.Tree CmmBlock-- Dominator tree in which children are sorted -- with highest reverse-postorder number first |