diff options
Diffstat (limited to 'compiler/GHC/CmmToAsm')
28 files changed, 550 insertions, 312 deletions
diff --git a/compiler/GHC/CmmToAsm/BlockLayout.hs b/compiler/GHC/CmmToAsm/BlockLayout.hs index d93b84887e..21b6865699 100644 --- a/compiler/GHC/CmmToAsm/BlockLayout.hs +++ b/compiler/GHC/CmmToAsm/BlockLayout.hs @@ -22,6 +22,7 @@ import GHC.Driver.Ppr (pprTrace) import GHC.CmmToAsm.Instr import GHC.CmmToAsm.Monad import GHC.CmmToAsm.CFG +import GHC.CmmToAsm.Types import GHC.Cmm.BlockId import GHC.Cmm @@ -668,7 +669,7 @@ buildChains edges blocks -- | Place basic blocks based on the given CFG. -- 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. -> CFG -- ^ Control flow graph and some meta data. -> [GenBasicBlock i] -- ^ List of basic blocks to be placed. @@ -815,7 +816,7 @@ dropJumps info ((BasicBlock lbl ins):todo) -- fallthroughs. sequenceTop - :: (Instruction instr, Outputable instr) + :: Instruction instr => DynFlags -- Determine which layout algo to use -> NcgImpl statics instr jumpDest -> Maybe CFG -- ^ CFG if we have one. diff --git a/compiler/GHC/CmmToAsm/Instr.hs b/compiler/GHC/CmmToAsm/Instr.hs index 869c5eb238..0a62c1d3bb 100644 --- a/compiler/GHC/CmmToAsm/Instr.hs +++ b/compiler/GHC/CmmToAsm/Instr.hs @@ -1,28 +1,18 @@ -module GHC.CmmToAsm.Instr ( - RegUsage(..), - noUsage, - GenBasicBlock(..), blockId, - ListGraph(..), - NatCmm, - NatCmmDecl, - NatBasicBlock, - topInfoTable, - entryBlocks, - Instruction(..) -) - +module GHC.CmmToAsm.Instr + ( Instruction(..) + , RegUsage(..) + , noUsage + ) where import GHC.Prelude import GHC.Platform import GHC.Platform.Reg +import GHC.Utils.Outputable (SDoc) import GHC.Cmm.BlockId -import GHC.Cmm.Dataflow.Collections -import GHC.Cmm.Dataflow.Label -import GHC.Cmm hiding (topInfoTable) import GHC.CmmToAsm.Config @@ -46,51 +36,11 @@ data RegUsage noUsage :: RegUsage 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 - entries = case code of - [] -> infos - BasicBlock entry _ : _ -- first block is the entry point - | entry `elem` infos -> infos - | otherwise -> entry : infos -entryBlocks _ = [] - -- | Common things that we can do with instructions, on all architectures. -- These are used by the shared parts of the native code generator, -- specifically the register allocators. -- -class Instruction instr where +class Instruction instr where -- | Get the registers that are being used by this instruction. -- regUsage doesn't need to do any trickery for jumps and such. @@ -204,3 +154,6 @@ class Instruction instr where :: Platform -> Int -> [instr] + + -- | Pretty-print an instruction + pprInstr :: Platform -> instr -> SDoc diff --git a/compiler/GHC/CmmToAsm/Monad.hs b/compiler/GHC/CmmToAsm/Monad.hs index 04921f7022..5a77e051cc 100644 --- a/compiler/GHC/CmmToAsm/Monad.hs +++ b/compiler/GHC/CmmToAsm/Monad.hs @@ -53,6 +53,7 @@ import GHC.Platform.Reg import GHC.CmmToAsm.Format import GHC.CmmToAsm.Reg.Target import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Types import GHC.Cmm.BlockId import GHC.Cmm.Dataflow.Collections @@ -68,10 +69,8 @@ import GHC.Unit.Module import Control.Monad ( ap ) -import GHC.CmmToAsm.Instr import GHC.Utils.Outputable (SDoc, ppr) import GHC.Utils.Panic (pprPanic) -import GHC.Cmm (RawCmmDecl, RawCmmStatics) import GHC.CmmToAsm.CFG data NcgImpl statics instr jumpDest = NcgImpl { diff --git a/compiler/GHC/CmmToAsm/PIC.hs b/compiler/GHC/CmmToAsm/PIC.hs index 419f8eb9d8..d776b1addb 100644 --- a/compiler/GHC/CmmToAsm/PIC.hs +++ b/compiler/GHC/CmmToAsm/PIC.hs @@ -54,10 +54,10 @@ import qualified GHC.CmmToAsm.PPC.Regs as PPC import qualified GHC.CmmToAsm.X86.Instr as X86 import GHC.Platform -import GHC.CmmToAsm.Instr import GHC.Platform.Reg import GHC.CmmToAsm.Monad import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Types import GHC.Cmm.Dataflow.Collections diff --git a/compiler/GHC/CmmToAsm/PPC.hs b/compiler/GHC/CmmToAsm/PPC.hs new file mode 100644 index 0000000000..148fd1b4b2 --- /dev/null +++ b/compiler/GHC/CmmToAsm/PPC.hs @@ -0,0 +1,61 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | Native code generator for PPC architectures +module GHC.CmmToAsm.PPC + ( ncgPPC + ) +where + +import GHC.Prelude + +import GHC.CmmToAsm.Instr +import GHC.CmmToAsm.Monad +import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Types + +import qualified GHC.CmmToAsm.PPC.Instr as PPC +import qualified GHC.CmmToAsm.PPC.Ppr as PPC +import qualified GHC.CmmToAsm.PPC.CodeGen as PPC +import qualified GHC.CmmToAsm.PPC.Regs as PPC +import qualified GHC.CmmToAsm.PPC.RegInfo as PPC + +ncgPPC :: NCGConfig -> NcgImpl RawCmmStatics PPC.Instr PPC.JumpDest +ncgPPC config = NcgImpl + { ncgConfig = config + , cmmTopCodeGen = PPC.cmmTopCodeGen + , generateJumpTableForInstr = PPC.generateJumpTableForInstr config + , getJumpDestBlockId = PPC.getJumpDestBlockId + , canShortcut = PPC.canShortcut + , shortcutStatics = PPC.shortcutStatics + , shortcutJump = PPC.shortcutJump + , pprNatCmmDecl = PPC.pprNatCmmDecl config + , maxSpillSlots = PPC.maxSpillSlots config + , allocatableRegs = PPC.allocatableRegs platform + , ncgAllocMoreStack = PPC.allocMoreStack platform + , ncgExpandTop = id + , ncgMakeFarBranches = PPC.makeFarBranches + , extractUnwindPoints = const [] + , invertCondBranches = \_ _ -> id + } + where + platform = ncgPlatform config + +-- | Instruction instance for powerpc +instance Instruction PPC.Instr where + regUsageOfInstr = PPC.regUsageOfInstr + patchRegsOfInstr = PPC.patchRegsOfInstr + isJumpishInstr = PPC.isJumpishInstr + jumpDestsOfInstr = PPC.jumpDestsOfInstr + patchJumpInstr = PPC.patchJumpInstr + mkSpillInstr = PPC.mkSpillInstr + mkLoadInstr = PPC.mkLoadInstr + takeDeltaInstr = PPC.takeDeltaInstr + isMetaInstr = PPC.isMetaInstr + mkRegRegMoveInstr _ = PPC.mkRegRegMoveInstr + takeRegRegMoveInstr = PPC.takeRegRegMoveInstr + mkJumpInstr = PPC.mkJumpInstr + mkStackAllocInstr = PPC.mkStackAllocInstr + mkStackDeallocInstr = PPC.mkStackDeallocInstr + pprInstr = PPC.pprInstr + + diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs index e704beb61f..b25e6187b9 100644 --- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs +++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs @@ -30,6 +30,7 @@ import GHC.CmmToAsm.PPC.Instr import GHC.CmmToAsm.PPC.Cond import GHC.CmmToAsm.PPC.Regs import GHC.CmmToAsm.CPrim +import GHC.CmmToAsm.Types import GHC.Cmm.DebugBlock ( DebugBlock(..) ) import GHC.CmmToAsm.Monad @@ -38,7 +39,6 @@ import GHC.CmmToAsm.Monad , getPicBaseMaybeNat, getPlatform, getConfig , getDebugBlock, getFileId ) -import GHC.CmmToAsm.Instr import GHC.CmmToAsm.PIC import GHC.CmmToAsm.Format import GHC.CmmToAsm.Config diff --git a/compiler/GHC/CmmToAsm/PPC/Instr.hs b/compiler/GHC/CmmToAsm/PPC/Instr.hs index 29655647fa..46c5afb04c 100644 --- a/compiler/GHC/CmmToAsm/PPC/Instr.hs +++ b/compiler/GHC/CmmToAsm/PPC/Instr.hs @@ -12,23 +12,37 @@ #include "HsVersions.h" -module GHC.CmmToAsm.PPC.Instr ( - archWordFormat, - RI(..), - Instr(..), - stackFrameHeaderSize, - maxSpillSlots, - allocMoreStack, - makeFarBranches -) - +module GHC.CmmToAsm.PPC.Instr + ( Instr(..) + , RI(..) + , archWordFormat + , stackFrameHeaderSize + , maxSpillSlots + , allocMoreStack + , makeFarBranches + , mkJumpInstr + , mkLoadInstr + , mkSpillInstr + , patchJumpInstr + , patchRegsOfInstr + , jumpDestsOfInstr + , takeRegRegMoveInstr + , takeDeltaInstr + , mkRegRegMoveInstr + , mkStackAllocInstr + , mkStackDeallocInstr + , regUsageOfInstr + , isJumpishInstr + , isMetaInstr + ) where import GHC.Prelude import GHC.CmmToAsm.PPC.Regs import GHC.CmmToAsm.PPC.Cond -import GHC.CmmToAsm.Instr +import GHC.CmmToAsm.Types +import GHC.CmmToAsm.Instr (RegUsage(..), noUsage) import GHC.CmmToAsm.Format import GHC.CmmToAsm.Reg.Target import GHC.CmmToAsm.Config @@ -60,34 +74,16 @@ archWordFormat is32Bit | otherwise = II64 --- | Instruction instance for powerpc -instance Instruction Instr where - regUsageOfInstr = ppc_regUsageOfInstr - patchRegsOfInstr = ppc_patchRegsOfInstr - isJumpishInstr = ppc_isJumpishInstr - jumpDestsOfInstr = ppc_jumpDestsOfInstr - patchJumpInstr = ppc_patchJumpInstr - mkSpillInstr = ppc_mkSpillInstr - mkLoadInstr = ppc_mkLoadInstr - takeDeltaInstr = ppc_takeDeltaInstr - isMetaInstr = ppc_isMetaInstr - mkRegRegMoveInstr _ = ppc_mkRegRegMoveInstr - takeRegRegMoveInstr = ppc_takeRegRegMoveInstr - mkJumpInstr = ppc_mkJumpInstr - mkStackAllocInstr = ppc_mkStackAllocInstr - mkStackDeallocInstr = ppc_mkStackDeallocInstr - - -ppc_mkStackAllocInstr :: Platform -> Int -> [Instr] -ppc_mkStackAllocInstr platform amount - = ppc_mkStackAllocInstr' platform (-amount) - -ppc_mkStackDeallocInstr :: Platform -> Int -> [Instr] -ppc_mkStackDeallocInstr platform amount - = ppc_mkStackAllocInstr' platform amount - -ppc_mkStackAllocInstr' :: Platform -> Int -> [Instr] -ppc_mkStackAllocInstr' platform amount +mkStackAllocInstr :: Platform -> Int -> [Instr] +mkStackAllocInstr platform amount + = mkStackAllocInstr' platform (-amount) + +mkStackDeallocInstr :: Platform -> Int -> [Instr] +mkStackDeallocInstr platform amount + = mkStackAllocInstr' platform amount + +mkStackAllocInstr' :: Platform -> Int -> [Instr] +mkStackAllocInstr' platform amount | fits16Bits amount = [ LD fmt r0 (AddrRegImm sp zero) , STU fmt r0 (AddrRegImm sp immAmount) @@ -313,8 +309,8 @@ data Instr -- The consequences of control flow transfers, as far as register -- allocation goes, are taken care of by the register allocator. -- -ppc_regUsageOfInstr :: Platform -> Instr -> RegUsage -ppc_regUsageOfInstr platform instr +regUsageOfInstr :: Platform -> Instr -> RegUsage +regUsageOfInstr platform instr = case instr of LD _ reg addr -> usage (regAddr addr, [reg]) LDFAR _ reg addr -> usage (regAddr addr, [reg]) @@ -406,8 +402,8 @@ interesting _ (RegReal (RealRegPair{})) -- | Apply a given mapping to all the register references in this -- instruction. -ppc_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr -ppc_patchRegsOfInstr instr env +patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr +patchRegsOfInstr instr env = case instr of LD fmt reg addr -> LD fmt (env reg) (fixAddr addr) LDFAR fmt reg addr -> LDFAR fmt (env reg) (fixAddr addr) @@ -497,8 +493,8 @@ ppc_patchRegsOfInstr instr env -- | Checks whether this instruction is a jump/branch instruction. -- One that can change the flow of control in a way that the -- register allocator needs to worry about. -ppc_isJumpishInstr :: Instr -> Bool -ppc_isJumpishInstr instr +isJumpishInstr :: Instr -> Bool +isJumpishInstr instr = case instr of BCC{} -> True BCCFAR{} -> True @@ -512,8 +508,8 @@ ppc_isJumpishInstr instr -- | Checks whether this instruction is a jump/branch instruction. -- One that can change the flow of control in a way that the -- register allocator needs to worry about. -ppc_jumpDestsOfInstr :: Instr -> [BlockId] -ppc_jumpDestsOfInstr insn +jumpDestsOfInstr :: Instr -> [BlockId] +jumpDestsOfInstr insn = case insn of BCC _ id _ -> [id] BCCFAR _ id _ -> [id] @@ -524,8 +520,8 @@ ppc_jumpDestsOfInstr insn -- | Change the destination of this jump instruction. -- Used in the linear allocator when adding fixup blocks for join -- points. -ppc_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr -ppc_patchJumpInstr insn patchF +patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr +patchJumpInstr insn patchF = case insn of BCC cc id p -> BCC cc (patchF id) p BCCFAR cc id p -> BCCFAR cc (patchF id) p @@ -536,14 +532,14 @@ ppc_patchJumpInstr insn patchF -- ----------------------------------------------------------------------------- -- | An instruction to spill a register into a spill slot. -ppc_mkSpillInstr +mkSpillInstr :: NCGConfig -> Reg -- register to spill -> Int -- current stack delta -> Int -- spill slot to use -> Instr -ppc_mkSpillInstr config reg delta slot +mkSpillInstr config reg delta slot = let platform = ncgPlatform config off = spillSlotToOffset platform slot arch = platformArch platform @@ -561,14 +557,14 @@ ppc_mkSpillInstr config reg delta slot in instr fmt reg (AddrRegImm sp (ImmInt (off-delta))) -ppc_mkLoadInstr +mkLoadInstr :: NCGConfig -> Reg -- register to load -> Int -- current stack delta -> Int -- spill slot to use -> Instr -ppc_mkLoadInstr config reg delta slot +mkLoadInstr config reg delta slot = let platform = ncgPlatform config off = spillSlotToOffset platform slot arch = platformArch platform @@ -629,21 +625,21 @@ spillSlotToOffset platform slot -------------------------------------------------------------------------------- -- | See if this instruction is telling us the current C stack delta -ppc_takeDeltaInstr +takeDeltaInstr :: Instr -> Maybe Int -ppc_takeDeltaInstr instr +takeDeltaInstr instr = case instr of DELTA i -> Just i _ -> Nothing -ppc_isMetaInstr +isMetaInstr :: Instr -> Bool -ppc_isMetaInstr instr +isMetaInstr instr = case instr of COMMENT{} -> True LOCATION{} -> True @@ -655,29 +651,29 @@ ppc_isMetaInstr instr -- | Copy the value in a register to another one. -- Must work for all register classes. -ppc_mkRegRegMoveInstr +mkRegRegMoveInstr :: Reg -> Reg -> Instr -ppc_mkRegRegMoveInstr src dst +mkRegRegMoveInstr src dst = MR dst src -- | Make an unconditional jump instruction. -ppc_mkJumpInstr +mkJumpInstr :: BlockId -> [Instr] -ppc_mkJumpInstr id +mkJumpInstr id = [BCC ALWAYS id Nothing] -- | Take the source and destination from this reg -> reg move instruction -- or Nothing if it's not one -ppc_takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg) -ppc_takeRegRegMoveInstr (MR dst src) = Just (src,dst) -ppc_takeRegRegMoveInstr _ = Nothing +takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg) +takeRegRegMoveInstr (MR dst src) = Just (src,dst) +takeRegRegMoveInstr _ = Nothing -- ----------------------------------------------------------------------------- -- Making far branches diff --git a/compiler/GHC/CmmToAsm/PPC/Ppr.hs b/compiler/GHC/CmmToAsm/PPC/Ppr.hs index 99cb22ba28..3622121e6c 100644 --- a/compiler/GHC/CmmToAsm/PPC/Ppr.hs +++ b/compiler/GHC/CmmToAsm/PPC/Ppr.hs @@ -6,8 +6,11 @@ -- ----------------------------------------------------------------------------- -{-# OPTIONS_GHC -fno-warn-orphans #-} -module GHC.CmmToAsm.PPC.Ppr (pprNatCmmDecl) where +module GHC.CmmToAsm.PPC.Ppr + ( pprNatCmmDecl + , pprInstr + ) +where import GHC.Prelude @@ -15,12 +18,13 @@ import GHC.CmmToAsm.PPC.Regs import GHC.CmmToAsm.PPC.Instr import GHC.CmmToAsm.PPC.Cond import GHC.CmmToAsm.Ppr -import GHC.CmmToAsm.Instr import GHC.CmmToAsm.Format import GHC.Platform.Reg import GHC.Platform.Reg.Class import GHC.CmmToAsm.Reg.Target import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Types +import GHC.CmmToAsm.Utils import GHC.Cmm hiding (topInfoTable) import GHC.Cmm.Dataflow.Collections @@ -35,7 +39,6 @@ import GHC.Platform import GHC.Data.FastString import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Driver.Session (targetPlatform) import Data.Word import Data.Int @@ -185,11 +188,6 @@ pprLabel platform lbl = -- ----------------------------------------------------------------------------- -- pprInstr: print an 'Instr' -instance Outputable Instr where - ppr instr = sdocWithDynFlags $ \dflags -> - pprInstr (targetPlatform dflags) instr - - pprReg :: Reg -> SDoc pprReg r diff --git a/compiler/GHC/CmmToAsm/Reg/Graph.hs b/compiler/GHC/CmmToAsm/Reg/Graph.hs index c544d9ff8a..f31e84a5ff 100644 --- a/compiler/GHC/CmmToAsm/Reg/Graph.hs +++ b/compiler/GHC/CmmToAsm/Reg/Graph.hs @@ -17,6 +17,7 @@ import GHC.CmmToAsm.Reg.Graph.TrivColorable import GHC.CmmToAsm.Instr import GHC.CmmToAsm.Reg.Target import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Types import GHC.Platform.Reg.Class import GHC.Platform.Reg @@ -45,7 +46,7 @@ maxSpinCount = 10 -- | The top level of the graph coloring register allocator. regAlloc - :: (Outputable statics, Outputable instr, Instruction instr) + :: (Outputable statics, Instruction instr) => NCGConfig -> UniqFM RegClass (UniqSet RealReg) -- ^ registers we can use for allocation -> UniqSet Int -- ^ set of available spill slots. @@ -90,7 +91,6 @@ regAlloc config regsFree slotsFree slotsCount code cfg regAlloc_spin :: forall instr statics. (Instruction instr, - Outputable instr, Outputable statics) => NCGConfig -> Int -- ^ Number of solver iterations we've already performed. @@ -388,7 +388,7 @@ graphAddCoalesce (r1, r2) graph -- | Patch registers in code using the reg -> reg mapping in this graph. patchRegsFromGraph - :: (Outputable statics, Outputable instr, Instruction instr) + :: (Outputable statics, Instruction instr) => Platform -> Color.Graph VirtualReg RegClass RealReg -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr @@ -413,7 +413,7 @@ patchRegsFromGraph platform graph code = pprPanic "patchRegsFromGraph: register mapping failed." ( text "There is no node in the graph for register " <> ppr reg - $$ ppr code + $$ pprLiveCmmDecl platform code $$ Color.dotGraph (\_ -> text "white") (trivColorable platform diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs b/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs index a5d09d5eea..872b01c11a 100644 --- a/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs +++ b/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs @@ -76,7 +76,7 @@ plusSpillCostRecord (r1, a1, b1, c1) (r2, a2, b2, c2) -- For each vreg, the number of times it was written to, read from, -- and the number of instructions it was live on entry to (lifetime) -- -slurpSpillCostInfo :: forall instr statics. (Outputable instr, Instruction instr) +slurpSpillCostInfo :: forall instr statics. Instruction instr => Platform -> Maybe CFG -> LiveCmmDecl statics instr @@ -116,7 +116,7 @@ slurpSpillCostInfo platform cfg cmm | otherwise = pprPanic "RegSpillCost.slurpSpillCostInfo" - $ text "no liveness information on instruction " <> ppr instr + $ text "no liveness information on instruction " <> pprInstr platform instr countLIs scale rsLiveEntry (LiveInstr instr (Just live) : lis) = do diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs index a0b1519a93..4e325e8778 100644 --- a/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs +++ b/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns, CPP #-} +{-# LANGUAGE BangPatterns, CPP, DeriveFunctor #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -23,15 +23,17 @@ import GHC.CmmToAsm.Reg.Liveness import GHC.CmmToAsm.Reg.Graph.Spill import GHC.CmmToAsm.Reg.Graph.SpillCost import GHC.CmmToAsm.Reg.Graph.TrivColorable -import GHC.CmmToAsm.Instr -import GHC.Platform.Reg.Class -import GHC.Platform.Reg import GHC.CmmToAsm.Reg.Target +import GHC.CmmToAsm.Instr +import GHC.CmmToAsm.Types + import GHC.Platform +import GHC.Platform.Reg +import GHC.Platform.Reg.Class -import GHC.Utils.Outputable import GHC.Types.Unique.FM import GHC.Types.Unique.Set +import GHC.Utils.Outputable import GHC.Utils.Monad.State -- | Holds interesting statistics from the register allocator. @@ -108,6 +110,7 @@ data RegAllocStats statics instr -- | Target platform , raPlatform :: !Platform } + deriving (Functor) instance (Outputable statics, Outputable instr) diff --git a/compiler/GHC/CmmToAsm/Reg/Linear.hs b/compiler/GHC/CmmToAsm/Reg/Linear.hs index 4d666bc557..8d4da4bd2e 100644 --- a/compiler/GHC/CmmToAsm/Reg/Linear.hs +++ b/compiler/GHC/CmmToAsm/Reg/Linear.hs @@ -122,6 +122,7 @@ import GHC.CmmToAsm.Reg.Liveness import GHC.CmmToAsm.Reg.Utils import GHC.CmmToAsm.Instr import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Types import GHC.Platform.Reg import GHC.Cmm.BlockId @@ -147,7 +148,7 @@ import Control.Applicative -- Allocate registers regAlloc - :: (Outputable instr, Instruction instr) + :: Instruction instr => NCGConfig -> LiveCmmDecl statics instr -> UniqSM ( NatCmmDecl statics instr @@ -204,7 +205,7 @@ regAlloc _ (CmmProc _ _ _ _) -- an entry in the block map or it is the first block. -- linearRegAlloc - :: (Outputable instr, Instruction instr) + :: Instruction instr => NCGConfig -> [BlockId] -- ^ entry points -> BlockMap RegSet @@ -236,7 +237,7 @@ linearRegAlloc config entry_ids block_live sccs -- | Constraints on the instruction instances used by the -- linear allocator. type OutputableRegConstraint freeRegs instr = - (FR freeRegs, Outputable freeRegs, Outputable instr, Instruction instr) + (FR freeRegs, Outputable freeRegs, Instruction instr) linearRegAlloc' :: OutputableRegConstraint freeRegs instr @@ -468,7 +469,10 @@ raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live)) -- See Note [Unique Determinism and code generation] raInsn _ _ _ instr - = pprPanic "raInsn" (text "no match for:" <> ppr instr) + = do + platform <- getPlatform + let instr' = fmap (pprInstr platform) instr + pprPanic "raInsn" (text "no match for:" <> ppr instr') -- ToDo: what can we do about -- @@ -764,7 +768,7 @@ data SpillLoc = ReadMem StackSlot -- reading from register only in memory -- the list of free registers and free stack slots. allocateRegsAndSpill - :: forall freeRegs instr. (FR freeRegs, Outputable instr, Instruction instr) + :: forall freeRegs instr. (FR freeRegs, Instruction instr) => Bool -- True <=> reading (load up spilled regs) -> [VirtualReg] -- don't push these out -> [instr] -- spill insns @@ -830,7 +834,7 @@ findPrefRealReg vreg = do -- reading is redundant with reason, but we keep it around because it's -- convenient and it maintains the recursive structure of the allocator. -- EZY -allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr, Outputable instr) +allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr) => Bool -> [VirtualReg] -> [instr] diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs b/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs index de489b342b..d0330a4f6a 100644 --- a/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs +++ b/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs @@ -18,12 +18,13 @@ import GHC.CmmToAsm.Reg.Linear.FreeRegs import GHC.CmmToAsm.Reg.Liveness import GHC.CmmToAsm.Instr import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Types + import GHC.Platform.Reg import GHC.Cmm.BlockId import GHC.Cmm.Dataflow.Collections import GHC.Data.Graph.Directed -import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.Unique import GHC.Types.Unique.FM @@ -33,7 +34,7 @@ import GHC.Types.Unique.Set -- vregs are in the correct regs for its destination. -- joinToTargets - :: (FR freeRegs, Instruction instr, Outputable instr) + :: (FR freeRegs, Instruction instr) => BlockMap RegSet -- ^ maps the unique of the blockid to the set of vregs -- that are known to be live on the entry to each block. @@ -57,7 +58,7 @@ joinToTargets block_live id instr ----- joinToTargets' - :: (FR freeRegs, Instruction instr, Outputable instr) + :: (FR freeRegs, Instruction instr) => BlockMap RegSet -- ^ maps the unique of the blockid to the set of vregs -- that are known to be live on the entry to each block. @@ -111,7 +112,7 @@ joinToTargets' block_live new_blocks block_id instr (dest:dests) -- this is the first time we jumped to this block. -joinToTargets_first :: (FR freeRegs, Instruction instr, Outputable instr) +joinToTargets_first :: (FR freeRegs, Instruction instr) => BlockMap RegSet -> [NatBasicBlock instr] -> BlockId @@ -140,7 +141,7 @@ joinToTargets_first block_live new_blocks block_id instr dest dests -- we've jumped to this block before -joinToTargets_again :: (Instruction instr, FR freeRegs, Outputable instr) +joinToTargets_again :: (Instruction instr, FR freeRegs) => BlockMap RegSet -> [NatBasicBlock instr] -> BlockId diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs b/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs index 6411e5285d..4d44b43492 100644 --- a/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs +++ b/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs @@ -12,10 +12,11 @@ import GHC.CmmToAsm.Reg.Linear.Base import GHC.CmmToAsm.Reg.Liveness import GHC.CmmToAsm.Instr import GHC.Types.Unique (Unique) +import GHC.CmmToAsm.Types import GHC.Types.Unique.FM -import GHC.Utils.Outputable +import GHC.Utils.Outputable import GHC.Utils.Monad.State -- | Build a map of how many times each reg was alloced, clobbered, loaded etc. diff --git a/compiler/GHC/CmmToAsm/Reg/Liveness.hs b/compiler/GHC/CmmToAsm/Reg/Liveness.hs index 00adf1cc34..09db54fa76 100644 --- a/compiler/GHC/CmmToAsm/Reg/Liveness.hs +++ b/compiler/GHC/CmmToAsm/Reg/Liveness.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveFunctor #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -26,6 +27,7 @@ module GHC.CmmToAsm.Reg.Liveness ( mapBlockTop, mapBlockTopM, mapSCCM, mapGenBlockTop, mapGenBlockTopM, + mapLiveCmmDecl, pprLiveCmmDecl, stripLive, stripLiveBlock, slurpConflicts, @@ -43,6 +45,8 @@ import GHC.Platform.Reg import GHC.CmmToAsm.Instr import GHC.CmmToAsm.CFG import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Types +import GHC.CmmToAsm.Utils import GHC.Cmm.BlockId import GHC.Cmm.Dataflow.Collections @@ -106,6 +110,8 @@ data InstrSR instr -- | reload this reg from a stack slot | RELOAD Int Reg + deriving (Functor) + instance Instruction instr => Instruction (InstrSR instr) where regUsageOfInstr platform i = case i of @@ -163,10 +169,13 @@ instance Instruction instr => Instruction (InstrSR instr) where mkStackDeallocInstr platform amount = Instr <$> mkStackDeallocInstr platform amount + pprInstr platform i = ppr (fmap (pprInstr platform) i) + -- | An instruction with liveness information. data LiveInstr instr = LiveInstr (InstrSR instr) (Maybe Liveness) + deriving (Functor) -- | Liveness information. -- The regs which die are ones which are no longer live in the *next* instruction @@ -494,7 +503,7 @@ slurpReloadCoalesce live -- | Strip away liveness information, yielding NatCmmDecl stripLive - :: (Outputable statics, Outputable instr, Instruction instr) + :: (Outputable statics, Instruction instr) => NCGConfig -> LiveCmmDecl statics instr -> NatCmmDecl statics instr @@ -502,7 +511,7 @@ stripLive stripLive config live = stripCmm live - where stripCmm :: (Outputable statics, Outputable instr, Instruction instr) + where stripCmm :: (Outputable statics, Instruction instr) => LiveCmmDecl statics instr -> NatCmmDecl statics instr stripCmm (CmmData sec ds) = CmmData sec ds stripCmm (CmmProc (LiveInfo info (first_id:_) _ _) label live sccs) @@ -519,7 +528,21 @@ stripLive config live -- If the proc has blocks but we don't know what the first one was, then we're dead. stripCmm proc - = pprPanic "RegAlloc.Liveness.stripLive: no first_id on proc" (ppr proc) + = pprPanic "RegAlloc.Liveness.stripLive: no first_id on proc" (pprLiveCmmDecl (ncgPlatform config) proc) + + +-- | Pretty-print a `LiveCmmDecl` +pprLiveCmmDecl :: (Outputable statics, Instruction instr) => Platform -> LiveCmmDecl statics instr -> SDoc +pprLiveCmmDecl platform d = ppr (mapLiveCmmDecl (pprInstr platform) d) + + +-- | Map over instruction type in `LiveCmmDecl` +mapLiveCmmDecl + :: Outputable statics + => (instr -> b) + -> LiveCmmDecl statics instr + -> LiveCmmDecl statics b +mapLiveCmmDecl f proc = fmap (fmap (fmap (fmap (fmap f)))) proc -- | Strip away liveness information from a basic block, -- and make real spill instructions out of SPILL, RELOAD pseudos along the way. @@ -653,15 +676,16 @@ patchRegsLiveInstr patchF li -- | Convert a NatCmmDecl to a LiveCmmDecl, with liveness information cmmTopLiveness - :: (Outputable instr, Instruction instr) - => Maybe CFG -> Platform + :: Instruction instr + => Maybe CFG + -> Platform -> NatCmmDecl statics instr -> UniqSM (LiveCmmDecl statics instr) cmmTopLiveness cfg platform cmm = regLiveness platform $ natCmmTopToLive cfg cmm natCmmTopToLive - :: (Instruction instr, Outputable instr) + :: Instruction instr => Maybe CFG -> NatCmmDecl statics instr -> LiveCmmDecl statics instr @@ -747,7 +771,7 @@ sccBlocks blocks entries mcfg = map (fmap node_payload) sccs -- regLiveness - :: (Outputable instr, Instruction instr) + :: Instruction instr => Platform -> LiveCmmDecl statics instr -> UniqSM (LiveCmmDecl statics instr) @@ -830,7 +854,7 @@ reverseBlocksInTops top -- want for the next pass. -- computeLiveness - :: (Outputable instr, Instruction instr) + :: Instruction instr => Platform -> [SCC (LiveBasicBlock instr)] -> ([SCC (LiveBasicBlock instr)], -- instructions annotated with list of registers @@ -841,10 +865,11 @@ computeLiveness computeLiveness platform sccs = case checkIsReverseDependent sccs of Nothing -> livenessSCCs platform mapEmpty [] sccs - Just bad -> pprPanic "RegAlloc.Liveness.computeLiveness" + Just bad -> let sccs' = fmap (fmap (fmap (fmap (pprInstr platform)))) sccs + in pprPanic "RegAlloc.Liveness.computeLiveness" (vcat [ text "SCCs aren't in reverse dependent order" , text "bad blockId" <+> ppr bad - , ppr sccs]) + , ppr sccs']) livenessSCCs :: Instruction instr diff --git a/compiler/GHC/CmmToAsm/SPARC.hs b/compiler/GHC/CmmToAsm/SPARC.hs new file mode 100644 index 0000000000..fe6c824a09 --- /dev/null +++ b/compiler/GHC/CmmToAsm/SPARC.hs @@ -0,0 +1,75 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | Native code generator for SPARC architectures +module GHC.CmmToAsm.SPARC + ( ncgSPARC + ) +where + +import GHC.Prelude +import GHC.Utils.Panic + +import GHC.CmmToAsm.Monad +import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Types +import GHC.CmmToAsm.Instr + +import qualified GHC.CmmToAsm.SPARC.Instr as SPARC +import qualified GHC.CmmToAsm.SPARC.Ppr as SPARC +import qualified GHC.CmmToAsm.SPARC.CodeGen as SPARC +import qualified GHC.CmmToAsm.SPARC.CodeGen.Expand as SPARC +import qualified GHC.CmmToAsm.SPARC.Regs as SPARC +import qualified GHC.CmmToAsm.SPARC.ShortcutJump as SPARC + + +ncgSPARC :: NCGConfig -> NcgImpl RawCmmStatics SPARC.Instr SPARC.JumpDest +ncgSPARC config = NcgImpl + { ncgConfig = config + , cmmTopCodeGen = SPARC.cmmTopCodeGen + , generateJumpTableForInstr = SPARC.generateJumpTableForInstr platform + , getJumpDestBlockId = SPARC.getJumpDestBlockId + , canShortcut = SPARC.canShortcut + , shortcutStatics = SPARC.shortcutStatics + , shortcutJump = SPARC.shortcutJump + , pprNatCmmDecl = SPARC.pprNatCmmDecl config + , maxSpillSlots = SPARC.maxSpillSlots config + , allocatableRegs = SPARC.allocatableRegs + , ncgExpandTop = map SPARC.expandTop + , ncgMakeFarBranches = const id + , extractUnwindPoints = const [] + , invertCondBranches = \_ _ -> id + -- Allocating more stack space for spilling isn't currently supported for the + -- linear register allocator on SPARC, hence the panic below. + , ncgAllocMoreStack = noAllocMoreStack + } + where + platform = ncgPlatform config + + 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" + + +-- | instance for sparc instruction set +instance Instruction SPARC.Instr where + regUsageOfInstr = SPARC.regUsageOfInstr + patchRegsOfInstr = SPARC.patchRegsOfInstr + isJumpishInstr = SPARC.isJumpishInstr + jumpDestsOfInstr = SPARC.jumpDestsOfInstr + patchJumpInstr = SPARC.patchJumpInstr + mkSpillInstr = SPARC.mkSpillInstr + mkLoadInstr = SPARC.mkLoadInstr + takeDeltaInstr = SPARC.takeDeltaInstr + isMetaInstr = SPARC.isMetaInstr + mkRegRegMoveInstr = SPARC.mkRegRegMoveInstr + takeRegRegMoveInstr = SPARC.takeRegRegMoveInstr + mkJumpInstr = SPARC.mkJumpInstr + pprInstr = const SPARC.pprInstr + mkStackAllocInstr = panic "no sparc_mkStackAllocInstr" + mkStackDeallocInstr = panic "no sparc_mkStackDeallocInstr" + + diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs index fcebf9c487..82da39d893 100644 --- a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs +++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs @@ -34,7 +34,7 @@ import GHC.CmmToAsm.SPARC.Imm import GHC.CmmToAsm.SPARC.AddrMode import GHC.CmmToAsm.SPARC.Regs import GHC.CmmToAsm.SPARC.Stack -import GHC.CmmToAsm.Instr +import GHC.CmmToAsm.Types import GHC.CmmToAsm.Format import GHC.CmmToAsm.Monad ( NatM, getNewRegNat, getNewLabelNat, getPlatform, getConfig ) import GHC.CmmToAsm.Config diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Expand.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Expand.hs index c1660f989b..a36f893ce3 100644 --- a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Expand.hs +++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Expand.hs @@ -13,11 +13,12 @@ import GHC.CmmToAsm.SPARC.Instr import GHC.CmmToAsm.SPARC.Imm import GHC.CmmToAsm.SPARC.AddrMode import GHC.CmmToAsm.SPARC.Regs -import GHC.CmmToAsm.Instr -import GHC.Platform.Reg import GHC.CmmToAsm.Format +import GHC.CmmToAsm.Types import GHC.Cmm +import GHC.Platform.Reg + import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Data.OrdList diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs index 52d4f125b5..ac5ff79579 100644 --- a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs +++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs @@ -16,9 +16,7 @@ import GHC.CmmToAsm.SPARC.Regs import GHC.CmmToAsm.SPARC.AddrMode import GHC.CmmToAsm.SPARC.Imm import GHC.CmmToAsm.SPARC.Instr --- GHC.CmmToAsm.SPARC.Ppr() import GHC.CmmToAsm.Monad -import GHC.CmmToAsm.Instr import GHC.CmmToAsm.Format import GHC.Platform.Reg diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs index a1060e5cf2..4bbb3e3823 100644 --- a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs +++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs @@ -10,7 +10,7 @@ import GHC.Prelude import GHC.CmmToAsm.SPARC.Instr import GHC.CmmToAsm.SPARC.Ppr () -- For Outputable instances -import GHC.CmmToAsm.Instr +import GHC.CmmToAsm.Types import GHC.Cmm diff --git a/compiler/GHC/CmmToAsm/SPARC/Instr.hs b/compiler/GHC/CmmToAsm/SPARC/Instr.hs index 7f0db3c18d..64b9276ac1 100644 --- a/compiler/GHC/CmmToAsm/SPARC/Instr.hs +++ b/compiler/GHC/CmmToAsm/SPARC/Instr.hs @@ -9,22 +9,31 @@ ----------------------------------------------------------------------------- #include "HsVersions.h" -module GHC.CmmToAsm.SPARC.Instr ( - RI(..), - riZero, - - fpRelEA, - moveSp, - - isUnconditionalJump, - - Instr(..), - maxSpillSlots -) - +module GHC.CmmToAsm.SPARC.Instr + ( Instr(..) + , RI(..) + , riZero + , fpRelEA + , moveSp + , isUnconditionalJump + , maxSpillSlots + , patchRegsOfInstr + , patchJumpInstr + , mkRegRegMoveInstr + , mkLoadInstr + , mkSpillInstr + , mkJumpInstr + , takeDeltaInstr + , isMetaInstr + , isJumpishInstr + , jumpDestsOfInstr + , takeRegRegMoveInstr + , regUsageOfInstr + ) where import GHC.Prelude +import GHC.Platform import GHC.CmmToAsm.SPARC.Stack import GHC.CmmToAsm.SPARC.Imm @@ -33,19 +42,19 @@ import GHC.CmmToAsm.SPARC.Cond import GHC.CmmToAsm.SPARC.Regs import GHC.CmmToAsm.SPARC.Base import GHC.CmmToAsm.Reg.Target -import GHC.CmmToAsm.Instr -import GHC.Platform.Reg.Class -import GHC.Platform.Reg import GHC.CmmToAsm.Format import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Instr (RegUsage(..), noUsage) -import GHC.Cmm.CLabel +import GHC.Platform.Reg.Class +import GHC.Platform.Reg import GHC.Platform.Regs + +import GHC.Cmm.CLabel import GHC.Cmm.BlockId import GHC.Cmm import GHC.Data.FastString import GHC.Utils.Panic -import GHC.Platform -- | Register or immediate @@ -88,24 +97,6 @@ isUnconditionalJump ii _ -> False --- | instance for sparc instruction set -instance Instruction Instr where - regUsageOfInstr = sparc_regUsageOfInstr - patchRegsOfInstr = sparc_patchRegsOfInstr - isJumpishInstr = sparc_isJumpishInstr - jumpDestsOfInstr = sparc_jumpDestsOfInstr - patchJumpInstr = sparc_patchJumpInstr - mkSpillInstr = sparc_mkSpillInstr - mkLoadInstr = sparc_mkLoadInstr - takeDeltaInstr = sparc_takeDeltaInstr - isMetaInstr = sparc_isMetaInstr - mkRegRegMoveInstr = sparc_mkRegRegMoveInstr - takeRegRegMoveInstr = sparc_takeRegRegMoveInstr - mkJumpInstr = sparc_mkJumpInstr - mkStackAllocInstr = panic "no sparc_mkStackAllocInstr" - mkStackDeallocInstr = panic "no sparc_mkStackDeallocInstr" - - -- | SPARC instruction set. -- Not complete. This is only the ones we need. -- @@ -218,8 +209,8 @@ data Instr -- consequences of control flow transfers, as far as register -- allocation goes, are taken care of by the register allocator. -- -sparc_regUsageOfInstr :: Platform -> Instr -> RegUsage -sparc_regUsageOfInstr platform instr +regUsageOfInstr :: Platform -> Instr -> RegUsage +regUsageOfInstr platform instr = case instr of LD _ addr reg -> usage (regAddr addr, [reg]) ST _ reg addr -> usage (reg : regAddr addr, []) @@ -285,8 +276,8 @@ interesting platform reg -- | Apply a given mapping to tall the register references in this instruction. -sparc_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr -sparc_patchRegsOfInstr instr env = case instr of +patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr +patchRegsOfInstr instr env = case instr of LD fmt addr reg -> LD fmt (fixAddr addr) (env reg) ST fmt reg addr -> ST fmt (env reg) (fixAddr addr) @@ -337,8 +328,8 @@ sparc_patchRegsOfInstr instr env = case instr of -------------------------------------------------------------------------------- -sparc_isJumpishInstr :: Instr -> Bool -sparc_isJumpishInstr instr +isJumpishInstr :: Instr -> Bool +isJumpishInstr instr = case instr of BI{} -> True BF{} -> True @@ -347,8 +338,8 @@ sparc_isJumpishInstr instr CALL{} -> True _ -> False -sparc_jumpDestsOfInstr :: Instr -> [BlockId] -sparc_jumpDestsOfInstr insn +jumpDestsOfInstr :: Instr -> [BlockId] +jumpDestsOfInstr insn = case insn of BI _ _ id -> [id] BF _ _ id -> [id] @@ -356,8 +347,8 @@ sparc_jumpDestsOfInstr insn _ -> [] -sparc_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr -sparc_patchJumpInstr insn patchF +patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr +patchJumpInstr insn patchF = case insn of BI cc annul id -> BI cc annul (patchF id) BF cc annul id -> BF cc annul (patchF id) @@ -368,14 +359,14 @@ sparc_patchJumpInstr insn patchF -------------------------------------------------------------------------------- -- | Make a spill instruction. -- On SPARC we spill below frame pointer leaving 2 words/spill -sparc_mkSpillInstr +mkSpillInstr :: NCGConfig -> Reg -- ^ register to spill -> Int -- ^ current stack delta -> Int -- ^ spill slot to use -> Instr -sparc_mkSpillInstr config reg _ slot +mkSpillInstr config reg _ slot = let platform = ncgPlatform config off = spillSlotToOffset config slot off_w = 1 + (off `div` 4) @@ -388,14 +379,14 @@ sparc_mkSpillInstr config reg _ slot -- | Make a spill reload instruction. -sparc_mkLoadInstr +mkLoadInstr :: NCGConfig -> Reg -- ^ register to load into -> Int -- ^ current stack delta -> Int -- ^ spill slot to use -> Instr -sparc_mkLoadInstr config reg _ slot +mkLoadInstr config reg _ slot = let platform = ncgPlatform config off = spillSlotToOffset config slot off_w = 1 + (off `div` 4) @@ -409,21 +400,21 @@ sparc_mkLoadInstr config reg _ slot -------------------------------------------------------------------------------- -- | See if this instruction is telling us the current C stack delta -sparc_takeDeltaInstr +takeDeltaInstr :: Instr -> Maybe Int -sparc_takeDeltaInstr instr +takeDeltaInstr instr = case instr of DELTA i -> Just i _ -> Nothing -sparc_isMetaInstr +isMetaInstr :: Instr -> Bool -sparc_isMetaInstr instr +isMetaInstr instr = case instr of COMMENT{} -> True LDATA{} -> True @@ -437,13 +428,13 @@ sparc_isMetaInstr instr -- floating point and integer regs. If we need to do that then we -- have to go via memory. -- -sparc_mkRegRegMoveInstr +mkRegRegMoveInstr :: Platform -> Reg -> Reg -> Instr -sparc_mkRegRegMoveInstr platform src dst +mkRegRegMoveInstr platform src dst | srcClass <- targetClassOfReg platform src , dstClass <- targetClassOfReg platform dst , srcClass == dstClass @@ -460,8 +451,8 @@ sparc_mkRegRegMoveInstr platform src dst -- The register allocator attempts to eliminate reg->reg moves whenever it can, -- by assigning the src and dest temporaries to the same real register. -- -sparc_takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg) -sparc_takeRegRegMoveInstr instr +takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg) +takeRegRegMoveInstr instr = case instr of ADD False False src (RIReg src2) dst | g0 == src2 -> Just (src, dst) @@ -472,10 +463,10 @@ sparc_takeRegRegMoveInstr instr -- | Make an unconditional branch instruction. -sparc_mkJumpInstr +mkJumpInstr :: BlockId -> [Instr] -sparc_mkJumpInstr id +mkJumpInstr id = [BI ALWAYS False id , NOP] -- fill the branch delay slot. diff --git a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs index 98f6096ac1..9d6acd16f8 100644 --- a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs +++ b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs @@ -9,7 +9,6 @@ ----------------------------------------------------------------------------- {-# OPTIONS_GHC -fno-warn-orphans #-} - module GHC.CmmToAsm.SPARC.Ppr ( pprNatCmmDecl, pprBasicBlock, @@ -32,11 +31,12 @@ import GHC.CmmToAsm.SPARC.Cond import GHC.CmmToAsm.SPARC.Imm import GHC.CmmToAsm.SPARC.AddrMode import GHC.CmmToAsm.SPARC.Base -import GHC.CmmToAsm.Instr import GHC.Platform.Reg import GHC.CmmToAsm.Format import GHC.CmmToAsm.Ppr import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Types +import GHC.CmmToAsm.Utils import GHC.Cmm hiding (topInfoTable) import GHC.Cmm.Ppr() -- For Outputable instances diff --git a/compiler/GHC/CmmToAsm/Types.hs b/compiler/GHC/CmmToAsm/Types.hs new file mode 100644 index 0000000000..2c76b89e16 --- /dev/null +++ b/compiler/GHC/CmmToAsm/Types.hs @@ -0,0 +1,32 @@ +module GHC.CmmToAsm.Types + ( NatCmm + , NatCmmDecl + , NatBasicBlock + , GenBasicBlock(..) + , blockId + , ListGraph(..) + , RawCmmStatics + , RawCmmDecl + ) +where + +import GHC.Cmm.Dataflow.Label +import GHC.Cmm + + +-- 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 diff --git a/compiler/GHC/CmmToAsm/Utils.hs b/compiler/GHC/CmmToAsm/Utils.hs new file mode 100644 index 0000000000..648805f210 --- /dev/null +++ b/compiler/GHC/CmmToAsm/Utils.hs @@ -0,0 +1,33 @@ +module GHC.CmmToAsm.Utils + ( topInfoTable + , entryBlocks + ) +where + +import GHC.Prelude + +import GHC.Cmm.BlockId +import GHC.Cmm.Dataflow.Collections +import GHC.Cmm.Dataflow.Label +import GHC.Cmm hiding (topInfoTable) + +-- | 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 + entries = case code of + [] -> infos + BasicBlock entry _ : _ -- first block is the entry point + | entry `elem` infos -> infos + | otherwise -> entry : infos +entryBlocks _ = [] diff --git a/compiler/GHC/CmmToAsm/X86.hs b/compiler/GHC/CmmToAsm/X86.hs new file mode 100644 index 0000000000..dbeeddc184 --- /dev/null +++ b/compiler/GHC/CmmToAsm/X86.hs @@ -0,0 +1,65 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | Native code generator for x86 and x86-64 architectures +module GHC.CmmToAsm.X86 + ( ncgX86_64 + , ncgX86 + ) +where + +import GHC.Prelude + +import GHC.CmmToAsm.Instr +import GHC.CmmToAsm.Monad +import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Types +import GHC.Types.Basic (Alignment) + +import qualified GHC.CmmToAsm.X86.Instr as X86 +import qualified GHC.CmmToAsm.X86.Ppr as X86 +import qualified GHC.CmmToAsm.X86.CodeGen as X86 +import qualified GHC.CmmToAsm.X86.Regs as X86 + +ncgX86 :: NCGConfig -> NcgImpl (Alignment, RawCmmStatics) X86.Instr X86.JumpDest +ncgX86 = ncgX86_64 + + +ncgX86_64 :: NCGConfig -> NcgImpl (Alignment, RawCmmStatics) X86.Instr X86.JumpDest +ncgX86_64 config = NcgImpl + { ncgConfig = config + , cmmTopCodeGen = X86.cmmTopCodeGen + , generateJumpTableForInstr = X86.generateJumpTableForInstr config + , getJumpDestBlockId = X86.getJumpDestBlockId + , canShortcut = X86.canShortcut + , shortcutStatics = X86.shortcutStatics + , shortcutJump = X86.shortcutJump + , pprNatCmmDecl = X86.pprNatCmmDecl config + , maxSpillSlots = X86.maxSpillSlots config + , allocatableRegs = X86.allocatableRegs platform + , ncgAllocMoreStack = X86.allocMoreStack platform + , ncgExpandTop = id + , ncgMakeFarBranches = const id + , extractUnwindPoints = X86.extractUnwindPoints + , invertCondBranches = X86.invertCondBranches + } + where + platform = ncgPlatform config + +-- | Instruction instance for x86 instruction set. +instance Instruction X86.Instr where + regUsageOfInstr = X86.regUsageOfInstr + patchRegsOfInstr = X86.patchRegsOfInstr + isJumpishInstr = X86.isJumpishInstr + jumpDestsOfInstr = X86.jumpDestsOfInstr + patchJumpInstr = X86.patchJumpInstr + mkSpillInstr = X86.mkSpillInstr + mkLoadInstr = X86.mkLoadInstr + takeDeltaInstr = X86.takeDeltaInstr + isMetaInstr = X86.isMetaInstr + mkRegRegMoveInstr = X86.mkRegRegMoveInstr + takeRegRegMoveInstr = X86.takeRegRegMoveInstr + mkJumpInstr = X86.mkJumpInstr + mkStackAllocInstr = X86.mkStackAllocInstr + mkStackDeallocInstr = X86.mkStackDeallocInstr + pprInstr = X86.pprInstr + diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs index 85343f0666..51ee9ffce9 100644 --- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs +++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs @@ -46,11 +46,11 @@ import GHC.CmmToAsm.X86.RegInfo import GHC.Platform.Regs import GHC.CmmToAsm.CPrim +import GHC.CmmToAsm.Types import GHC.Cmm.DebugBlock ( DebugBlock(..), UnwindPoint(..), UnwindTable , UnwindExpr(UwReg), toUnwindExpr ) -import GHC.CmmToAsm.Instr import GHC.CmmToAsm.PIC import GHC.CmmToAsm.Monad ( NatM, getNewRegNat, getNewLabelNat, setDeltaNat diff --git a/compiler/GHC/CmmToAsm/X86/Instr.hs b/compiler/GHC/CmmToAsm/X86/Instr.hs index ae9d45462e..caf50ce2fc 100644 --- a/compiler/GHC/CmmToAsm/X86/Instr.hs +++ b/compiler/GHC/CmmToAsm/X86/Instr.hs @@ -9,10 +9,31 @@ ----------------------------------------------------------------------------- module GHC.CmmToAsm.X86.Instr - ( Instr(..), Operand(..), PrefetchVariant(..), JumpDest(..) - , getJumpDestBlockId, canShortcut, shortcutStatics - , shortcutJump, allocMoreStack - , maxSpillSlots, archWordFormat + ( Instr(..) + , Operand(..) + , PrefetchVariant(..) + , JumpDest(..) + , getJumpDestBlockId + , canShortcut + , shortcutStatics + , shortcutJump + , allocMoreStack + , maxSpillSlots + , archWordFormat + , takeRegRegMoveInstr + , regUsageOfInstr + , takeDeltaInstr + , mkLoadInstr + , mkJumpInstr + , mkStackAllocInstr + , mkStackDeallocInstr + , mkSpillInstr + , mkRegRegMoveInstr + , jumpDestsOfInstr + , patchRegsOfInstr + , patchJumpInstr + , isMetaInstr + , isJumpishInstr ) where @@ -22,8 +43,10 @@ import GHC.Prelude import GHC.CmmToAsm.X86.Cond import GHC.CmmToAsm.X86.Regs -import GHC.CmmToAsm.Instr import GHC.CmmToAsm.Format +import GHC.CmmToAsm.Types +import GHC.CmmToAsm.Utils +import GHC.CmmToAsm.Instr (RegUsage(..), noUsage) import GHC.Platform.Reg.Class import GHC.Platform.Reg import GHC.CmmToAsm.Reg.Target @@ -39,11 +62,11 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Platform -import GHC.Types.Basic (Alignment) import GHC.Cmm.CLabel import GHC.Types.Unique.Set import GHC.Types.Unique import GHC.Types.Unique.Supply +import GHC.Types.Basic (Alignment) import GHC.Cmm.DebugBlock (UnwindTable) import Control.Monad @@ -56,24 +79,6 @@ archWordFormat is32Bit | is32Bit = II32 | otherwise = II64 --- | Instruction instance for x86 instruction set. -instance Instruction Instr where - regUsageOfInstr = x86_regUsageOfInstr - patchRegsOfInstr = x86_patchRegsOfInstr - isJumpishInstr = x86_isJumpishInstr - jumpDestsOfInstr = x86_jumpDestsOfInstr - patchJumpInstr = x86_patchJumpInstr - mkSpillInstr = x86_mkSpillInstr - mkLoadInstr = x86_mkLoadInstr - takeDeltaInstr = x86_takeDeltaInstr - isMetaInstr = x86_isMetaInstr - mkRegRegMoveInstr = x86_mkRegRegMoveInstr - takeRegRegMoveInstr = x86_takeRegRegMoveInstr - mkJumpInstr = x86_mkJumpInstr - mkStackAllocInstr = x86_mkStackAllocInstr - mkStackDeallocInstr = x86_mkStackDeallocInstr - - -- ----------------------------------------------------------------------------- -- Intel x86 instructions @@ -345,8 +350,8 @@ data Operand -- | Returns which registers are read and written as a (read, written) -- pair. -x86_regUsageOfInstr :: Platform -> Instr -> RegUsage -x86_regUsageOfInstr platform instr +regUsageOfInstr :: Platform -> Instr -> RegUsage +regUsageOfInstr platform instr = case instr of MOV _ src dst -> usageRW src dst CMOV _ _ src dst -> mkRU (use_R src [dst]) [dst] @@ -430,7 +435,7 @@ x86_regUsageOfInstr platform instr -- note: might be a better way to do this PREFETCH _ _ src -> mkRU (use_R src []) [] - LOCK i -> x86_regUsageOfInstr platform i + LOCK i -> regUsageOfInstr platform i XADD _ src dst -> usageMM src dst CMPXCHG _ src dst -> usageRMM src dst (OpReg eax) XCHG _ src dst -> usageMM src (OpReg dst) @@ -514,8 +519,8 @@ interesting _ (RegReal (RealRegPair{})) = panic "X86.interesting: no re -- | Applies the supplied function to all registers in instructions. -- Typically used to change virtual registers to real registers. -x86_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr -x86_patchRegsOfInstr instr env +patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr +patchRegsOfInstr instr env = case instr of MOV fmt src dst -> patch2 (MOV fmt) src dst CMOV cc fmt src dst -> CMOV cc fmt (patchOp src) (env dst) @@ -590,7 +595,7 @@ x86_patchRegsOfInstr instr env PREFETCH lvl format src -> PREFETCH lvl format (patchOp src) - LOCK i -> LOCK (x86_patchRegsOfInstr i env) + LOCK i -> LOCK (patchRegsOfInstr i env) XADD fmt src dst -> patch2 (XADD fmt) src dst CMPXCHG fmt src dst -> patch2 (CMPXCHG fmt) src dst XCHG fmt src dst -> XCHG fmt (patchOp src) (env dst) @@ -621,10 +626,10 @@ x86_patchRegsOfInstr instr env -------------------------------------------------------------------------------- -x86_isJumpishInstr +isJumpishInstr :: Instr -> Bool -x86_isJumpishInstr instr +isJumpishInstr instr = case instr of JMP{} -> True JXX{} -> True @@ -634,21 +639,21 @@ x86_isJumpishInstr instr _ -> False -x86_jumpDestsOfInstr +jumpDestsOfInstr :: Instr -> [BlockId] -x86_jumpDestsOfInstr insn +jumpDestsOfInstr insn = case insn of JXX _ id -> [id] JMP_TBL _ ids _ _ -> [id | Just (DestBlockId id) <- ids] _ -> [] -x86_patchJumpInstr +patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr -x86_patchJumpInstr insn patchF +patchJumpInstr insn patchF = case insn of JXX cc id -> JXX cc (patchF id) JMP_TBL op ids section lbl @@ -664,14 +669,14 @@ x86_patchJumpInstr insn patchF -- ----------------------------------------------------------------------------- -- | Make a spill instruction. -x86_mkSpillInstr +mkSpillInstr :: NCGConfig -> Reg -- register to spill -> Int -- current stack delta -> Int -- spill slot to use -> Instr -x86_mkSpillInstr config reg delta slot +mkSpillInstr config reg delta slot = let off = spillSlotToOffset platform slot - delta in case targetClassOfReg platform reg of @@ -683,21 +688,21 @@ x86_mkSpillInstr config reg delta slot is32Bit = target32Bit platform -- | Make a spill reload instruction. -x86_mkLoadInstr +mkLoadInstr :: NCGConfig -> Reg -- register to load -> Int -- current stack delta -> Int -- spill slot to use -> Instr -x86_mkLoadInstr config reg delta slot +mkLoadInstr config reg delta slot = let off = spillSlotToOffset platform slot - delta in case targetClassOfReg platform reg of RcInteger -> MOV (archWordFormat is32Bit) (OpAddr (spRel platform off)) (OpReg reg) RcDouble -> MOV FF64 (OpAddr (spRel platform off)) (OpReg reg) - _ -> panic "X86.x86_mkLoadInstr" + _ -> panic "X86.mkLoadInstr" where platform = ncgPlatform config is32Bit = target32Bit platform @@ -725,21 +730,21 @@ spillSlotToOffset platform slot -------------------------------------------------------------------------------- -- | See if this instruction is telling us the current C stack delta -x86_takeDeltaInstr +takeDeltaInstr :: Instr -> Maybe Int -x86_takeDeltaInstr instr +takeDeltaInstr instr = case instr of DELTA i -> Just i _ -> Nothing -x86_isMetaInstr +isMetaInstr :: Instr -> Bool -x86_isMetaInstr instr +isMetaInstr instr = case instr of COMMENT{} -> True LOCATION{} -> True @@ -757,18 +762,18 @@ x86_isMetaInstr instr -- floating point and integer regs. If we need to do that then we -- have to go via memory. -- -x86_mkRegRegMoveInstr +mkRegRegMoveInstr :: Platform -> Reg -> Reg -> Instr -x86_mkRegRegMoveInstr platform src dst +mkRegRegMoveInstr platform src dst = case targetClassOfReg platform src of RcInteger -> case platformArch platform of ArchX86 -> MOV II32 (OpReg src) (OpReg dst) ArchX86_64 -> MOV II64 (OpReg src) (OpReg dst) - _ -> panic "x86_mkRegRegMoveInstr: Bad arch" + _ -> panic "X86.mkRegRegMoveInstr: Bad arch" RcDouble -> MOV FF64 (OpReg src) (OpReg dst) -- this code is the lie we tell ourselves because both float and double -- use the same register class.on x86_64 and x86 32bit with SSE2, @@ -779,22 +784,22 @@ x86_mkRegRegMoveInstr platform src dst -- The register allocator attempts to eliminate reg->reg moves whenever it can, -- by assigning the src and dest temporaries to the same real register. -- -x86_takeRegRegMoveInstr +takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg) -x86_takeRegRegMoveInstr (MOV _ (OpReg r1) (OpReg r2)) +takeRegRegMoveInstr (MOV _ (OpReg r1) (OpReg r2)) = Just (r1,r2) -x86_takeRegRegMoveInstr _ = Nothing +takeRegRegMoveInstr _ = Nothing -- | Make an unconditional branch instruction. -x86_mkJumpInstr +mkJumpInstr :: BlockId -> [Instr] -x86_mkJumpInstr id +mkJumpInstr id = [JXX ALWAYS id] -- Note [Windows stack layout] @@ -837,11 +842,11 @@ needs_probe_call platform amount _ -> False _ -> False -x86_mkStackAllocInstr +mkStackAllocInstr :: Platform -> Int -> [Instr] -x86_mkStackAllocInstr platform amount +mkStackAllocInstr platform amount = case platformOS platform of OSMinGW32 -> -- These will clobber AX but this should be ok because @@ -880,22 +885,22 @@ x86_mkStackAllocInstr platform amount [ SUB II64 (OpImm (ImmInt amount)) (OpReg rsp) , TEST II64 (OpReg rsp) (OpReg rsp) ] - _ -> panic "x86_mkStackAllocInstr" + _ -> panic "X86.mkStackAllocInstr" _ -> case platformArch platform of ArchX86 -> [ SUB II32 (OpImm (ImmInt amount)) (OpReg esp) ] ArchX86_64 -> [ SUB II64 (OpImm (ImmInt amount)) (OpReg rsp) ] - _ -> panic "x86_mkStackAllocInstr" + _ -> panic "X86.mkStackAllocInstr" -x86_mkStackDeallocInstr +mkStackDeallocInstr :: Platform -> Int -> [Instr] -x86_mkStackDeallocInstr platform amount +mkStackDeallocInstr platform amount = case platformArch platform of ArchX86 -> [ADD II32 (OpImm (ImmInt amount)) (OpReg esp)] ArchX86_64 -> [ADD II64 (OpImm (ImmInt amount)) (OpReg rsp)] - _ -> panic "x86_mkStackDeallocInstr" + _ -> panic "X86.mkStackDeallocInstr" -- @@ -976,7 +981,7 @@ allocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do insert_dealloc insn r = case insn of JMP _ _ -> dealloc ++ (insn : r) JXX_GBL _ _ -> panic "insert_dealloc: cannot handle JXX_GBL" - _other -> x86_patchJumpInstr insn retarget : r + _other -> patchJumpInstr insn retarget : r where retarget b = fromMaybe b (mapLookup b new_blockmap) new_code = concatMap insert_stack_insns code diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs index a733290733..410eddbf85 100644 --- a/compiler/GHC/CmmToAsm/X86/Ppr.hs +++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs @@ -8,7 +8,6 @@ -- ----------------------------------------------------------------------------- -{-# OPTIONS_GHC -fno-warn-orphans #-} module GHC.CmmToAsm.X86.Ppr ( pprNatCmmDecl, pprData, @@ -24,25 +23,27 @@ where import GHC.Prelude +import GHC.Platform +import GHC.Platform.Reg + import GHC.CmmToAsm.X86.Regs import GHC.CmmToAsm.X86.Instr import GHC.CmmToAsm.X86.Cond -import GHC.CmmToAsm.Instr import GHC.CmmToAsm.Config import GHC.CmmToAsm.Format -import GHC.Platform.Reg +import GHC.CmmToAsm.Types +import GHC.CmmToAsm.Utils import GHC.CmmToAsm.Ppr - +import GHC.Cmm hiding (topInfoTable) import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow.Label -import GHC.Types.Basic (Alignment, mkAlignment, alignmentBytes) -import GHC.Driver.Session -import GHC.Cmm hiding (topInfoTable) import GHC.Cmm.BlockId import GHC.Cmm.CLabel + +import GHC.Types.Basic (Alignment, mkAlignment, alignmentBytes) import GHC.Types.Unique ( pprUniqueAlways ) -import GHC.Platform + import GHC.Data.FastString import GHC.Utils.Outputable import GHC.Utils.Panic @@ -270,11 +271,6 @@ pprAlign platform alignment log2 8 = 3 log2 n = 1 + log2 (n `quot` 2) -instance Outputable Instr where - ppr instr = sdocWithDynFlags $ \dflags -> - pprInstr (targetPlatform dflags) instr - - pprReg :: Platform -> Format -> Reg -> SDoc pprReg platform f r = case r of |