summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCheng Shao <terrorjack@type.dance>2023-04-07 18:39:59 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2023-04-11 19:25:31 -0400
commit05d26a650b6e9e1169b42376fe54bb00850722f2 (patch)
treecad24aef8cae27d1d0ab46092df1480250aec4af
parent6c3926167dc6c2978531ecac06e1eda50874297a (diff)
downloadhaskell-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.hs2
-rw-r--r--compiler/GHC/Wasm/ControlFlow/FromCmm.hs11
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