Commit 0c5ed5c7 authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot
Browse files

DynFlags: refactor GHC.CmmToAsm (#17957, #10143)

This patch removes the use of `sdocWithDynFlags` from GHC.CmmToAsm.*.Ppr

To do that I've had to make some refactoring:

* X86' and PPC's `Instr` are no longer `Outputable` as they require a
  `Platform` argument

* `Instruction` class now exposes `pprInstr :: Platform -> instr -> SDoc`

* as a consequence, I've refactored some modules to avoid .hs-boot files

* added (derived) functor instances for some datatypes parametric in the
  instruction type. It's useful for pretty-printing as we just have to
  map `pprInstr` before pretty-printing the container datatype.
parent aa4b744d
...@@ -3,6 +3,7 @@ ...@@ -3,6 +3,7 @@
{-# LANGUAGE KindSignatures #-} {-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE DeriveFunctor #-}
module GHC.Cmm ( module GHC.Cmm (
-- * Cmm top-level datatypes -- * Cmm top-level datatypes
...@@ -96,6 +97,8 @@ data GenCmmDecl d h g ...@@ -96,6 +97,8 @@ data GenCmmDecl d h g
Section Section
d d
deriving (Functor)
type CmmDecl = GenCmmDecl CmmStatics CmmTopInfo CmmGraph type CmmDecl = GenCmmDecl CmmStatics CmmTopInfo CmmGraph
type CmmDeclSRTs = GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph type CmmDeclSRTs = GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
...@@ -246,14 +249,19 @@ type RawCmmStatics = GenCmmStatics 'True ...@@ -246,14 +249,19 @@ type RawCmmStatics = GenCmmStatics 'True
-- These are used by the LLVM and NCG backends, when populating Cmm -- These are used by the LLVM and NCG backends, when populating Cmm
-- with lists of instructions. -- with lists of instructions.
data GenBasicBlock i = BasicBlock BlockId [i] data GenBasicBlock i
= BasicBlock BlockId [i]
deriving (Functor)
-- | The branch block id is that of the first block in -- | The branch block id is that of the first block in
-- the branch, which is that branch's entry point -- the branch, which is that branch's entry point
blockId :: GenBasicBlock i -> BlockId blockId :: GenBasicBlock i -> BlockId
blockId (BasicBlock blk_id _ ) = blk_id blockId (BasicBlock blk_id _ ) = blk_id
newtype ListGraph i = ListGraph [GenBasicBlock i] newtype ListGraph i
= ListGraph [GenBasicBlock i]
deriving (Functor)
instance Outputable instr => Outputable (ListGraph instr) where instance Outputable instr => Outputable (ListGraph instr) where
ppr (ListGraph blocks) = vcat (map ppr blocks) ppr (ListGraph blocks) = vcat (map ppr blocks)
......
...@@ -2,7 +2,6 @@ ...@@ -2,7 +2,6 @@
-- --
-- (c) The University of Glasgow 1993-2004 -- (c) The University of Glasgow 1993-2004
-- --
-- This is the top-level module in the native code generator.
-- --
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
...@@ -15,40 +14,74 @@ ...@@ -15,40 +14,74 @@
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.CmmToAsm ( -- | Native code generator
-- * Module entry point --
nativeCodeGen -- The native-code generator has machine-independent and
-- machine-dependent modules.
-- * Test-only exports: see trac #12744 --
-- used by testGraphNoSpills, which needs to access -- This module ("GHC.CmmToAsm") is the top-level machine-independent
-- the register allocator intermediate data structures -- module. Before entering machine-dependent land, we do some
-- cmmNativeGen emits -- machine-independent optimisations (defined below) on the
, cmmNativeGen -- 'CmmStmts's.
, NcgImpl(..) --
, x86NcgImpl -- We convert to the machine-specific 'Instr' datatype with
) where -- 'cmmCodeGen', assuming an infinite supply of registers. We then use
-- a machine-independent register allocator ('regAlloc') to rejoin
-- reality. Obviously, 'regAlloc' has machine-specific helper
-- functions (see about "RegAllocInfo" below).
--
-- Finally, we order the basic blocks of the function so as to minimise
-- the number of jumps between blocks, by utilising fallthrough wherever
-- possible.
--
-- The machine-dependent bits break down as follows:
--
-- * ["MachRegs"] Everything about the target platform's machine
-- registers (and immediate operands, and addresses, which tend to
-- intermingle/interact with registers).
--
-- * ["MachInstrs"] Includes the 'Instr' datatype (possibly should
-- have a module of its own), plus a miscellany of other things
-- (e.g., 'targetDoubleSize', 'smStablePtrTable', ...)
--
-- * ["MachCodeGen"] is where 'Cmm' stuff turns into
-- machine instructions.
--
-- * ["PprMach"] 'pprInstr' turns an 'Instr' into text (well, really
-- a 'SDoc').
--
-- * ["RegAllocInfo"] In the register allocator, we manipulate
-- 'MRegsState's, which are 'BitSet's, one bit per machine register.
-- When we want to say something about a specific machine register
-- (e.g., ``it gets clobbered by this instruction''), we set/unset
-- its bit. Obviously, we do this 'BitSet' thing for efficiency
-- reasons.
--
-- The 'RegAllocInfo' module collects together the machine-specific
-- info needed to do register allocation.
--
-- * ["RegisterAlloc"] The (machine-independent) register allocator.
-- -}
--
module GHC.CmmToAsm
( nativeCodeGen
-- * Test-only exports: see trac #12744
-- used by testGraphNoSpills, which needs to access
-- the register allocator intermediate data structures
-- cmmNativeGen emits
, cmmNativeGen
, NcgImpl(..)
)
where
#include "HsVersions.h" #include "HsVersions.h"
import GHC.Prelude import GHC.Prelude
import qualified GHC.CmmToAsm.X86.CodeGen as X86.CodeGen import qualified GHC.CmmToAsm.X86 as X86
import qualified GHC.CmmToAsm.X86.Regs as X86.Regs import qualified GHC.CmmToAsm.PPC as PPC
import qualified GHC.CmmToAsm.X86.Instr as X86.Instr import qualified GHC.CmmToAsm.SPARC as SPARC
import qualified GHC.CmmToAsm.X86.Ppr as X86.Ppr
import qualified GHC.CmmToAsm.SPARC.CodeGen as SPARC.CodeGen
import qualified GHC.CmmToAsm.SPARC.Regs as SPARC.Regs
import qualified GHC.CmmToAsm.SPARC.Instr as SPARC.Instr
import qualified GHC.CmmToAsm.SPARC.Ppr as SPARC.Ppr
import qualified GHC.CmmToAsm.SPARC.ShortcutJump as SPARC.ShortcutJump
import qualified GHC.CmmToAsm.SPARC.CodeGen.Expand as SPARC.CodeGen.Expand
import qualified GHC.CmmToAsm.PPC.CodeGen as PPC.CodeGen
import qualified GHC.CmmToAsm.PPC.Regs as PPC.Regs
import qualified GHC.CmmToAsm.PPC.RegInfo as PPC.RegInfo
import qualified GHC.CmmToAsm.PPC.Instr as PPC.Instr
import qualified GHC.CmmToAsm.PPC.Ppr as PPC.Ppr
import GHC.CmmToAsm.Reg.Liveness import GHC.CmmToAsm.Reg.Liveness
import qualified GHC.CmmToAsm.Reg.Linear as Linear import qualified GHC.CmmToAsm.Reg.Linear as Linear
...@@ -71,6 +104,7 @@ import GHC.CmmToAsm.Monad ...@@ -71,6 +104,7 @@ import GHC.CmmToAsm.Monad
import GHC.CmmToAsm.CFG import GHC.CmmToAsm.CFG
import GHC.CmmToAsm.Dwarf import GHC.CmmToAsm.Dwarf
import GHC.CmmToAsm.Config import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Types
import GHC.Cmm.DebugBlock import GHC.Cmm.DebugBlock
import GHC.Cmm.BlockId import GHC.Cmm.BlockId
...@@ -90,7 +124,6 @@ import GHC.Driver.Session ...@@ -90,7 +124,6 @@ import GHC.Driver.Session
import GHC.Driver.Ppr import GHC.Driver.Ppr
import GHC.Utils.Misc import GHC.Utils.Misc
import GHC.Types.Basic ( Alignment )
import qualified GHC.Utils.Ppr as Pretty import qualified GHC.Utils.Ppr as Pretty
import GHC.Utils.BufHandle import GHC.Utils.BufHandle
import GHC.Utils.Outputable as Outputable import GHC.Utils.Outputable as Outputable
...@@ -102,9 +135,6 @@ import GHC.Unit ...@@ -102,9 +135,6 @@ import GHC.Unit
import GHC.Data.Stream (Stream) import GHC.Data.Stream (Stream)
import qualified GHC.Data.Stream as Stream import qualified GHC.Data.Stream as Stream
-- DEBUGGING ONLY
--import GHC.Data.OrdList
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.Ord ( comparing ) import Data.Ord ( comparing )
...@@ -112,54 +142,6 @@ import Control.Exception ...@@ -112,54 +142,6 @@ import Control.Exception
import Control.Monad import Control.Monad
import System.IO import System.IO
{-
The native-code generator has machine-independent and
machine-dependent modules.
This module ("AsmCodeGen") is the top-level machine-independent
module. Before entering machine-dependent land, we do some
machine-independent optimisations (defined below) on the
'CmmStmts's.
We convert to the machine-specific 'Instr' datatype with
'cmmCodeGen', assuming an infinite supply of registers. We then use
a machine-independent register allocator ('regAlloc') to rejoin
reality. Obviously, 'regAlloc' has machine-specific helper
functions (see about "RegAllocInfo" below).
Finally, we order the basic blocks of the function so as to minimise
the number of jumps between blocks, by utilising fallthrough wherever
possible.
The machine-dependent bits break down as follows:
* ["MachRegs"] Everything about the target platform's machine
registers (and immediate operands, and addresses, which tend to
intermingle/interact with registers).
* ["MachInstrs"] Includes the 'Instr' datatype (possibly should
have a module of its own), plus a miscellany of other things
(e.g., 'targetDoubleSize', 'smStablePtrTable', ...)
* ["MachCodeGen"] is where 'Cmm' stuff turns into
machine instructions.
* ["PprMach"] 'pprInstr' turns an 'Instr' into text (well, really
a 'SDoc').
* ["RegAllocInfo"] In the register allocator, we manipulate
'MRegsState's, which are 'BitSet's, one bit per machine register.
When we want to say something about a specific machine register
(e.g., ``it gets clobbered by this instruction''), we set/unset
its bit. Obviously, we do this 'BitSet' thing for efficiency
reasons.
The 'RegAllocInfo' module collects together the machine-specific
info needed to do register allocation.
* ["RegisterAlloc"] The (machine-independent) register allocator.
-}
-------------------- --------------------
nativeCodeGen :: forall a . DynFlags -> Module -> ModLocation -> Handle -> UniqSupply nativeCodeGen :: forall a . DynFlags -> Module -> ModLocation -> Handle -> UniqSupply
-> Stream IO RawCmmGroup a -> Stream IO RawCmmGroup a
...@@ -167,114 +149,25 @@ nativeCodeGen :: forall a . DynFlags -> Module -> ModLocation -> Handle -> UniqS ...@@ -167,114 +149,25 @@ nativeCodeGen :: forall a . DynFlags -> Module -> ModLocation -> Handle -> UniqS
nativeCodeGen dflags this_mod modLoc h us cmms nativeCodeGen dflags this_mod modLoc h us cmms
= let config = initConfig dflags = let config = initConfig dflags
platform = ncgPlatform config platform = ncgPlatform config
nCG' :: ( Outputable statics, Outputable instr nCG' :: ( Outputable statics, Outputable jumpDest, Instruction instr)
, Outputable jumpDest, Instruction instr)
=> NcgImpl statics instr jumpDest -> IO a => NcgImpl statics instr jumpDest -> IO a
nCG' ncgImpl = nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms nCG' ncgImpl = nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms
in case platformArch platform of in case platformArch platform of
ArchX86 -> nCG' (x86NcgImpl config) ArchX86 -> nCG' (X86.ncgX86 config)
ArchX86_64 -> nCG' (x86_64NcgImpl config) ArchX86_64 -> nCG' (X86.ncgX86_64 config)
ArchPPC -> nCG' (ppcNcgImpl config) ArchPPC -> nCG' (PPC.ncgPPC config)
ArchS390X -> panic "nativeCodeGen: No NCG for S390X" ArchPPC_64 _ -> nCG' (PPC.ncgPPC config)
ArchSPARC -> nCG' (sparcNcgImpl config) ArchSPARC -> nCG' (SPARC.ncgSPARC config)
ArchSPARC64 -> panic "nativeCodeGen: No NCG for SPARC64" ArchSPARC64 -> panic "nativeCodeGen: No NCG for SPARC64"
ArchS390X -> panic "nativeCodeGen: No NCG for S390X"
ArchARM {} -> panic "nativeCodeGen: No NCG for ARM" ArchARM {} -> panic "nativeCodeGen: No NCG for ARM"
ArchARM64 -> panic "nativeCodeGen: No NCG for ARM64" ArchARM64 -> panic "nativeCodeGen: No NCG for ARM64"
ArchPPC_64 _ -> nCG' (ppcNcgImpl config)
ArchAlpha -> panic "nativeCodeGen: No NCG for Alpha" ArchAlpha -> panic "nativeCodeGen: No NCG for Alpha"
ArchMipseb -> panic "nativeCodeGen: No NCG for mipseb" ArchMipseb -> panic "nativeCodeGen: No NCG for mipseb"
ArchMipsel -> panic "nativeCodeGen: No NCG for mipsel" ArchMipsel -> panic "nativeCodeGen: No NCG for mipsel"
ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch" ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch"
ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript" ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript"
x86NcgImpl :: NCGConfig -> NcgImpl (Alignment, RawCmmStatics)
X86.Instr.Instr X86.Instr.JumpDest
x86NcgImpl config
= (x86_64NcgImpl config)
x86_64NcgImpl :: NCGConfig -> NcgImpl (Alignment, RawCmmStatics)
X86.Instr.Instr X86.Instr.JumpDest
x86_64NcgImpl config
= NcgImpl {
ncgConfig = config
,cmmTopCodeGen = X86.CodeGen.cmmTopCodeGen
,generateJumpTableForInstr = X86.CodeGen.generateJumpTableForInstr config
,getJumpDestBlockId = X86.Instr.getJumpDestBlockId
,canShortcut = X86.Instr.canShortcut
,shortcutStatics = X86.Instr.shortcutStatics
,shortcutJump = X86.Instr.shortcutJump
,pprNatCmmDecl = X86.Ppr.pprNatCmmDecl config
,maxSpillSlots = X86.Instr.maxSpillSlots config
,allocatableRegs = X86.Regs.allocatableRegs platform
,ncgAllocMoreStack = X86.Instr.allocMoreStack platform
,ncgExpandTop = id
,ncgMakeFarBranches = const id
,extractUnwindPoints = X86.CodeGen.extractUnwindPoints
,invertCondBranches = X86.CodeGen.invertCondBranches
}
where
platform = ncgPlatform config
ppcNcgImpl :: NCGConfig -> NcgImpl RawCmmStatics PPC.Instr.Instr PPC.RegInfo.JumpDest
ppcNcgImpl config
= NcgImpl {
ncgConfig = config
,cmmTopCodeGen = PPC.CodeGen.cmmTopCodeGen
,generateJumpTableForInstr = PPC.CodeGen.generateJumpTableForInstr config
,getJumpDestBlockId = PPC.RegInfo.getJumpDestBlockId
,canShortcut = PPC.RegInfo.canShortcut
,shortcutStatics = PPC.RegInfo.shortcutStatics
,shortcutJump = PPC.RegInfo.shortcutJump
,pprNatCmmDecl = PPC.Ppr.pprNatCmmDecl config
,maxSpillSlots = PPC.Instr.maxSpillSlots config
,allocatableRegs = PPC.Regs.allocatableRegs platform
,ncgAllocMoreStack = PPC.Instr.allocMoreStack platform
,ncgExpandTop = id
,ncgMakeFarBranches = PPC.Instr.makeFarBranches
,extractUnwindPoints = const []
,invertCondBranches = \_ _ -> id
}
where
platform = ncgPlatform config
sparcNcgImpl :: NCGConfig -> NcgImpl RawCmmStatics SPARC.Instr.Instr SPARC.ShortcutJump.JumpDest
sparcNcgImpl config
= NcgImpl {
ncgConfig = config
,cmmTopCodeGen = SPARC.CodeGen.cmmTopCodeGen
,generateJumpTableForInstr = SPARC.CodeGen.generateJumpTableForInstr platform
,getJumpDestBlockId = SPARC.ShortcutJump.getJumpDestBlockId
,canShortcut = SPARC.ShortcutJump.canShortcut
,shortcutStatics = SPARC.ShortcutJump.shortcutStatics
,shortcutJump = SPARC.ShortcutJump.shortcutJump
,pprNatCmmDecl = SPARC.Ppr.pprNatCmmDecl config
,maxSpillSlots = SPARC.Instr.maxSpillSlots config
,allocatableRegs = SPARC.Regs.allocatableRegs
,ncgAllocMoreStack = noAllocMoreStack
,ncgExpandTop = map SPARC.CodeGen.Expand.expandTop
,ncgMakeFarBranches = const id
,extractUnwindPoints = const []
,invertCondBranches = \_ _ -> id
}
where
platform = ncgPlatform config
--
-- Allocating more stack space for spilling is currently only
-- supported for the linear register allocator on x86/x86_64, the rest
-- default to the panic below. To support allocating extra stack on
-- more platforms provide a definition of ncgAllocMoreStack.
--
noAllocMoreStack :: Int -> NatCmmDecl statics instr
-> UniqSM (NatCmmDecl statics instr, [(BlockId,BlockId)])
noAllocMoreStack amount _
= panic $ "Register allocator: out of stack slots (need " ++ show amount ++ ")\n"
++ " If you are trying to compile SHA1.hs from the crypto library then this\n"
++ " is a known limitation in the linear allocator.\n"
++ "\n"
++ " Try enabling the graph colouring allocator with -fregs-graph instead."
++ " You can still file a bug report if you like.\n"
-- | Data accumulated during code generation. Mostly about statistics, -- | Data accumulated during code generation. Mostly about statistics,
-- but also collects debug data for DWARF generation. -- but also collects debug data for DWARF generation.
...@@ -320,8 +213,7 @@ unwinding table). ...@@ -320,8 +213,7 @@ unwinding table).
See also Note [What is this unwinding business?] in "GHC.Cmm.DebugBlock". See also Note [What is this unwinding business?] in "GHC.Cmm.DebugBlock".
-} -}
nativeCodeGen' :: (Outputable statics, Outputable instr,Outputable jumpDest, nativeCodeGen' :: (Outputable statics, Outputable jumpDest, Instruction instr)
Instruction instr)
=> DynFlags => DynFlags
-> Module -> ModLocation -> Module -> ModLocation
-> NcgImpl statics instr jumpDest -> NcgImpl statics instr jumpDest
...@@ -397,8 +289,7 @@ finishNativeGen dflags modLoc bufh@(BufHandle _ _ h) us ngs ...@@ -397,8 +289,7 @@ finishNativeGen dflags modLoc bufh@(BufHandle _ _ h) us ngs
(dumpOptionsFromFlag Opt_D_dump_asm_stats) "NCG stats" (dumpOptionsFromFlag Opt_D_dump_asm_stats) "NCG stats"
FormatText FormatText
cmmNativeGenStream :: (Outputable statics, Outputable instr cmmNativeGenStream :: (Outputable statics, Outputable jumpDest, Instruction instr)
,Outputable jumpDest, Instruction instr)
=> DynFlags => DynFlags
-> Module -> ModLocation -> Module -> ModLocation
-> NcgImpl statics instr jumpDest -> NcgImpl statics instr jumpDest
...@@ -453,8 +344,7 @@ cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs ...@@ -453,8 +344,7 @@ cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs
-- | Do native code generation on all these cmms. -- | Do native code generation on all these cmms.
-- --
cmmNativeGens :: forall statics instr jumpDest. cmmNativeGens :: forall statics instr jumpDest.
(Outputable statics, Outputable instr (Outputable statics, Outputable jumpDest, Instruction instr)
,Outputable jumpDest, Instruction instr)
=> DynFlags => DynFlags
-> Module -> ModLocation -> Module -> ModLocation
-> NcgImpl statics instr jumpDest -> NcgImpl statics instr jumpDest
...@@ -530,8 +420,7 @@ emitNativeCode dflags h sdoc = do ...@@ -530,8 +420,7 @@ emitNativeCode dflags h sdoc = do
-- Dumping the output of each stage along the way. -- Dumping the output of each stage along the way.
-- Global conflict graph and NGC stats -- Global conflict graph and NGC stats
cmmNativeGen cmmNativeGen
:: forall statics instr jumpDest. (Instruction instr, :: forall statics instr jumpDest. (Instruction instr, Outputable statics, Outputable jumpDest)
Outputable statics, Outputable instr, Outputable jumpDest)
=> DynFlags => DynFlags
-> Module -> ModLocation -> Module -> ModLocation
-> NcgImpl statics instr jumpDest -> NcgImpl statics instr jumpDest
...@@ -602,7 +491,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count ...@@ -602,7 +491,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
dumpIfSet_dyn dflags dumpIfSet_dyn dflags
Opt_D_dump_asm_liveness "Liveness annotations added" Opt_D_dump_asm_liveness "Liveness annotations added"
FormatCMM FormatCMM
(vcat $ map ppr withLiveness) (vcat $ map (pprLiveCmmDecl platform) withLiveness)
-- allocate registers -- allocate registers
(alloced, usAlloc, ppr_raStatsColor, ppr_raStatsLinear, raStats, stack_updt_blks) <- (alloced, usAlloc, ppr_raStatsColor, ppr_raStatsLinear, raStats, stack_updt_blks) <-
...@@ -650,7 +539,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count ...@@ -650,7 +539,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
(vcat $ map (\(stage, stats) (vcat $ map (\(stage, stats)
-> text "# --------------------------" -> text "# --------------------------"
$$ text "# cmm " <> int count <> text " Stage " <> int stage $$ text "# cmm " <> int count <> text " Stage " <> int stage
$$ ppr stats) $$ ppr (fmap (pprInstr platform) stats))
$ zip [0..] regAllocStats) $ zip [0..] regAllocStats)
let mPprStats = let mPprStats =
......
...@@ -22,6 +22,7 @@ import GHC.Driver.Ppr (pprTrace) ...@@ -22,6 +22,7 @@ import GHC.Driver.Ppr (pprTrace)
import GHC.CmmToAsm.Instr import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.Monad import GHC.CmmToAsm.Monad
import GHC.CmmToAsm.CFG import GHC.CmmToAsm.CFG
import GHC.CmmToAsm.Types
import GHC.Cmm.BlockId import GHC.Cmm.BlockId
import GHC.Cmm import GHC.Cmm
...@@ -668,7 +669,7 @@ buildChains edges blocks ...@@ -668,7 +669,7 @@ buildChains edges blocks
-- | Place basic blocks based on the given CFG. -- | Place basic blocks based on the given CFG.
-- See Note [Chain based CFG serialization] -- See Note [Chain based CFG serialization]
sequenceChain :: forall a i. (Instruction i, Outputable i) sequenceChain :: forall a i. Instruction i
=> LabelMap a -- ^ Keys indicate an info table on the block. => LabelMap a -- ^ Keys indicate an info table on the block.
-> CFG -- ^ Control flow graph and some meta data. -> CFG -- ^ Control flow graph and some meta data.
-> [GenBasicBlock i] -- ^ List of basic blocks to be placed. -> [GenBasicBlock i] -- ^ List of basic blocks to be placed.
...@@ -815,7 +816,7 @@ dropJumps info ((BasicBlock lbl ins):todo) ...@@ -815,7 +816,7 @@ dropJumps info ((BasicBlock lbl ins):todo)
-- fallthroughs. -- fallthroughs.
sequenceTop sequenceTop
:: (Instruction instr, Outputable instr) :: Instruction instr
=> DynFlags -- Determine which layout algo to use => DynFlags -- Determine which layout algo to use
-> NcgImpl statics instr jumpDest -> NcgImpl statics instr jumpDest
-> Maybe CFG -- ^ CFG if we have one. -> Maybe CFG -- ^ CFG if we have one.
......
module GHC.CmmToAsm.Instr ( module GHC.CmmToAsm.Instr
RegUsage(..), ( Instruction(..)
noUsage, , RegUsage(..)
GenBasicBlock(..), blockId, , noUsage
ListGraph(..), )
NatCmm,
NatCmmDecl,
NatBasicBlock,
topInfoTable,
entryBlocks,
Instruction(..)
)
where where
import GHC.Prelude import GHC.Prelude
import GHC.Platform import GHC.Platform
import GHC.Platform.Reg import GHC.Platform.Reg
import GHC.Utils.Outputable (SDoc)
import GHC.Cmm.BlockId import GHC.Cmm.BlockId
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Label
import GHC.Cmm hiding (topInfoTable)
import GHC.CmmToAsm.Config import GHC.CmmToAsm.Config
...@@ -46,51 +36,11 @@ data RegUsage ...@@ -46,51 +36,11 @@ data RegUsage
noUsage :: RegUsage noUsage :: RegUsage
noUsage = RU [] [] noUsage = RU [] []
-- Our flavours of the Cmm types
-- Type synonyms for Cmm populated with native code
type NatCmm instr
= GenCmmGroup
RawCmmStatics
(LabelMap RawCmmStatics)
(ListGraph instr)
type NatCmmDecl statics instr
= GenCmmDecl
statics
(LabelMap RawCmmStatics)
(ListGraph instr)
type NatBasicBlock instr
= GenBasicBlock instr
-- | Returns the info table associated with the CmmDecl's entry point,
-- if any.
topInfoTable :: GenCmmDecl a (LabelMap i) (ListGraph b) -> Maybe i
topInfoTable (CmmProc infos _ _ (ListGraph (b:_)))
= mapLookup (blockId b) infos
topInfoTable _
= Nothing
-- | Return the list of BlockIds in a CmmDecl that are entry points
-- for this proc (i.e. they may be jumped to from outside this proc).
entryBlocks :: GenCmmDecl a (LabelMap i) (ListGraph b) -> [BlockId]
entryBlocks (CmmProc info _ _ (ListGraph code)) = entries
where
infos = mapKeys info