[Git][ghc/ghc][wip/angerman/aarch64-ncg] 2 commits: Cleanup
Moritz Angermann
gitlab at gitlab.haskell.org
Sat Sep 12 10:54:04 UTC 2020
Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC
Commits:
ec59228d by Moritz Angermann at 2020-09-12T06:49:31+00:00
Cleanup
Also align with the new CmmToAsm module layout.
- - - - -
e8060bf8 by Moritz Angermann at 2020-09-12T10:53:53+00:00
Adds missing module
- - - - -
7 changed files:
- compiler/GHC/CmmToAsm.hs
- + compiler/GHC/CmmToAsm/AArch64.hs
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/CmmToAsm/Instr.hs
- compiler/ghc.cabal.in
Changes:
=====================================
compiler/GHC/CmmToAsm.hs
=====================================
@@ -83,12 +83,7 @@ import GHC.Prelude
import qualified GHC.CmmToAsm.X86 as X86
import qualified GHC.CmmToAsm.PPC as PPC
import qualified GHC.CmmToAsm.SPARC as SPARC
-
-import qualified GHC.CmmToAsm.AArch64.CodeGen as AArch64.CodeGen
-import qualified GHC.CmmToAsm.AArch64.Regs as AArch64.Regs
-import qualified GHC.CmmToAsm.AArch64.RegInfo as AArch64.RegInfo
-import qualified GHC.CmmToAsm.AArch64.Instr as AArch64.Instr
-import qualified GHC.CmmToAsm.AArch64.Ppr as AArch64.Ppr
+import qualified GHC.CmmToAsm.AArch64 as AArch64
import GHC.CmmToAsm.Reg.Liveness
import qualified GHC.CmmToAsm.Reg.Linear as Linear
@@ -168,50 +163,13 @@ nativeCodeGen dflags this_mod modLoc h us cmms
ArchSPARC64 -> panic "nativeCodeGen: No NCG for SPARC64"
ArchS390X -> panic "nativeCodeGen: No NCG for S390X"
ArchARM {} -> panic "nativeCodeGen: No NCG for ARM"
- ArchAArch64 -> nCG' (aarch64NcgImpl config)
+ ArchAArch64 -> nCG' (AArch64.ncgAArch64 config)
ArchAlpha -> panic "nativeCodeGen: No NCG for Alpha"
ArchMipseb -> panic "nativeCodeGen: No NCG for mipseb"
ArchMipsel -> panic "nativeCodeGen: No NCG for mipsel"
ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch"
ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript"
-aarch64NcgImpl :: NCGConfig -> NcgImpl RawCmmStatics AArch64.Instr.Instr AArch64.RegInfo.JumpDest
-aarch64NcgImpl config
- = NcgImpl {
- ncgConfig = config
- ,cmmTopCodeGen = AArch64.CodeGen.cmmTopCodeGen
- ,generateJumpTableForInstr = AArch64.CodeGen.generateJumpTableForInstr config
- ,getJumpDestBlockId = AArch64.RegInfo.getJumpDestBlockId
- ,canShortcut = AArch64.RegInfo.canShortcut
- ,shortcutStatics = AArch64.RegInfo.shortcutStatics
- ,shortcutJump = AArch64.RegInfo.shortcutJump
- ,pprNatCmmDecl = AArch64.Ppr.pprNatCmmDecl config
- ,maxSpillSlots = AArch64.Instr.maxSpillSlots config
- ,allocatableRegs = AArch64.Regs.allocatableRegs platform
- ,ncgAllocMoreStack = AArch64.Instr.allocMoreStack platform
- ,ncgExpandTop = id
- ,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,
-- but also collects debug data for DWARF generation.
data NativeGenAcc statics instr
=====================================
compiler/GHC/CmmToAsm/AArch64.hs
=====================================
@@ -0,0 +1,60 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-- | Native code generator for x86 and x86-64 architectures
+module GHC.CmmToAsm.AArch64
+ ( ncgAArch64 )
+where
+
+import GHC.Prelude
+
+import GHC.CmmToAsm.Instr
+import GHC.CmmToAsm.Monad
+import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.Types
+
+import qualified GHC.CmmToAsm.AArch64.Instr as AArch64
+import qualified GHC.CmmToAsm.AArch64.Ppr as AArch64
+import qualified GHC.CmmToAsm.AArch64.CodeGen as AArch64
+import qualified GHC.CmmToAsm.AArch64.Regs as AArch64
+import qualified GHC.CmmToAsm.AArch64.RegInfo as AArch64
+
+ncgAArch64 :: NCGConfig -> NcgImpl RawCmmStatics AArch64.Instr AArch64.JumpDest
+ncgAArch64 config
+ = NcgImpl {
+ ncgConfig = config
+ ,cmmTopCodeGen = AArch64.cmmTopCodeGen
+ ,generateJumpTableForInstr = AArch64.generateJumpTableForInstr config
+ ,getJumpDestBlockId = AArch64.getJumpDestBlockId
+ ,canShortcut = AArch64.canShortcut
+ ,shortcutStatics = AArch64.shortcutStatics
+ ,shortcutJump = AArch64.shortcutJump
+ ,pprNatCmmDecl = AArch64.pprNatCmmDecl config
+ ,maxSpillSlots = AArch64.maxSpillSlots config
+ ,allocatableRegs = AArch64.allocatableRegs platform
+ ,ncgAllocMoreStack = AArch64.allocMoreStack platform
+ ,ncgExpandTop = id
+ ,ncgMakeFarBranches = const id
+ ,extractUnwindPoints = const []
+ ,invertCondBranches = \_ _ -> id
+ }
+ where
+ platform = ncgPlatform config
+
+-- | Instruction instance for aarch64
+instance Instruction AArch64.Instr where
+ regUsageOfInstr = AArch64.regUsageOfInstr
+ patchRegsOfInstr = AArch64.patchRegsOfInstr
+ isJumpishInstr = AArch64.isJumpishInstr
+ jumpDestsOfInstr = AArch64.jumpDestsOfInstr
+ patchJumpInstr = AArch64.patchJumpInstr
+ mkSpillInstr = AArch64.mkSpillInstr
+ mkLoadInstr = AArch64.mkLoadInstr
+ takeDeltaInstr = AArch64.takeDeltaInstr
+ isMetaInstr = AArch64.isMetaInstr
+ mkRegRegMoveInstr _ = AArch64.mkRegRegMoveInstr
+ takeRegRegMoveInstr = AArch64.takeRegRegMoveInstr
+ mkJumpInstr = AArch64.mkJumpInstr
+ mkStackAllocInstr = AArch64.mkStackAllocInstr
+ mkStackDeallocInstr = AArch64.mkStackDeallocInstr
+ mkComment = pure . AArch64.COMMENT
+ pprInstr = AArch64.pprInstr
=====================================
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
=====================================
@@ -27,7 +27,7 @@ import GHC.CmmToAsm.Monad
, getPicBaseMaybeNat, getPlatform, getConfig
, getDebugBlock, getFileId
)
-import GHC.CmmToAsm.Instr
+-- import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.PIC
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Config
@@ -337,15 +337,15 @@ isIntFormat = not . isFloatFormat
-- -----------------------------------------------------------------------------
-- General things for putting together code sequences
--- Expand CmmRegOff. ToDo: should we do it this way around, or convert
--- CmmExprs into CmmRegOff?
-mangleIndexTree :: Platform -> CmmExpr -> CmmExpr
-mangleIndexTree platform (CmmRegOff reg off)
- = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]
- where width = typeWidth (cmmRegType platform reg)
+-- -- Expand CmmRegOff. ToDo: should we do it this way around, or convert
+-- -- CmmExprs into CmmRegOff?
+-- mangleIndexTree :: Platform -> CmmExpr -> CmmExpr
+-- mangleIndexTree platform (CmmRegOff reg off)
+-- = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]
+-- where width = typeWidth (cmmRegType platform reg)
-mangleIndexTree _ _
- = panic "AArch64.CodeGen.mangleIndexTree: no match"
+-- mangleIndexTree _ _
+-- = panic "AArch64.CodeGen.mangleIndexTree: no match"
-- | The dual to getAnyReg: compute an expression into a register, but
-- we don't mind which one it is.
=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# language CPP, BangPatterns #-}
module GHC.CmmToAsm.AArch64.Instr
@@ -11,7 +12,7 @@ import GHC.Prelude
import GHC.CmmToAsm.AArch64.Cond
import GHC.CmmToAsm.AArch64.Regs
-import GHC.CmmToAsm.Instr
+import GHC.CmmToAsm.Instr (RegUsage(..))
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Types
import GHC.CmmToAsm.Utils
@@ -69,24 +70,6 @@ spillSlotToOffset :: NCGConfig -> Int -> Int
spillSlotToOffset config slot
= stackFrameHeaderSize (ncgPlatform config) + spillSlotSize * slot
--- | Instruction instance for powerpc
-instance Instruction Instr where
- regUsageOfInstr = aarch64_regUsageOfInstr
- patchRegsOfInstr = aarch64_patchRegsOfInstr
- isJumpishInstr = aarch64_isJumpishInstr
- jumpDestsOfInstr = aarch64_jumpDestsOfInstr
- patchJumpInstr = aarch64_patchJumpInstr
- mkSpillInstr = aarch64_mkSpillInstr
- mkLoadInstr = aarch64_mkLoadInstr
- takeDeltaInstr = aarch64_takeDeltaInstr
- isMetaInstr = aarch64_isMetaInstr
- mkRegRegMoveInstr _ = aarch64_mkRegRegMoveInstr
- takeRegRegMoveInstr = aarch64_takeRegRegMoveInstr
- mkJumpInstr = aarch64_mkJumpInstr
- mkStackAllocInstr = aarch64_mkStackAllocInstr
- mkStackDeallocInstr = aarch64_mkStackDeallocInstr
- mkComment = pure . COMMENT
-
-- | Get the registers that are being used by this instruction.
-- regUsage doesn't need to do any trickery for jumps and such.
-- Just state precisely the regs read and written by that insn.
@@ -98,9 +81,9 @@ instance Instruction Instr where
instance Outputable RegUsage where
ppr (RU reads writes) = text "RegUsage(reads:" <+> ppr reads <> comma <+> text "writes:" <+> ppr writes <> char ')'
-aarch64_regUsageOfInstr :: Platform -> Instr -> RegUsage
-aarch64_regUsageOfInstr platform instr = case instr of
- ANN _ i -> aarch64_regUsageOfInstr platform i
+regUsageOfInstr :: Platform -> Instr -> RegUsage
+regUsageOfInstr platform instr = case instr of
+ ANN _ i -> regUsageOfInstr platform i
-- 1. Arithmetic Instructions ------------------------------------------------
ADD dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
CMN l r -> usage (regOp l ++ regOp r, [])
@@ -220,10 +203,10 @@ callerSavedRegisters
-- | Apply a given mapping to all the register references in this
-- instruction.
-aarch64_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
-aarch64_patchRegsOfInstr instr env = case instr of
+patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
+patchRegsOfInstr instr env = case instr of
-- 0. Meta Instructions
- ANN d i -> ANN d (aarch64_patchRegsOfInstr i env)
+ ANN d i -> ANN d (patchRegsOfInstr i env)
-- 1. Arithmetic Instructions ----------------------------------------------
ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3)
CMN o1 o2 -> CMN (patchOp o1) (patchOp o2)
@@ -281,7 +264,7 @@ aarch64_patchRegsOfInstr instr env = case instr of
SCVTF o1 o2 -> SCVTF (patchOp o1) (patchOp o2)
FCVTZS o1 o2 -> FCVTZS (patchOp o1) (patchOp o2)
- _ -> pprPanic "aarch64_patchRegsOfInstr" (text $ show instr)
+ _ -> pprPanic "patchRegsOfInstr" (text $ show instr)
where
patchOp :: Operand -> Operand
patchOp (OpReg w r) = OpReg w (env r)
@@ -300,9 +283,9 @@ aarch64_patchRegsOfInstr instr env = case instr of
-- | 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.
-aarch64_isJumpishInstr :: Instr -> Bool
-aarch64_isJumpishInstr instr = case instr of
- ANN _ i -> aarch64_isJumpishInstr i
+isJumpishInstr :: Instr -> Bool
+isJumpishInstr instr = case instr of
+ ANN _ i -> isJumpishInstr i
CBZ{} -> True
CBNZ{} -> True
J{} -> True
@@ -314,23 +297,23 @@ aarch64_isJumpishInstr instr = case instr of
-- | 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.
-aarch64_jumpDestsOfInstr :: Instr -> [BlockId]
-aarch64_jumpDestsOfInstr (ANN _ i) = aarch64_jumpDestsOfInstr i
-aarch64_jumpDestsOfInstr (CBZ _ t) = [ id | TBlock id <- [t]]
-aarch64_jumpDestsOfInstr (CBNZ _ t) = [ id | TBlock id <- [t]]
-aarch64_jumpDestsOfInstr (J t) = [id | TBlock id <- [t]]
-aarch64_jumpDestsOfInstr (B t) = [id | TBlock id <- [t]]
-aarch64_jumpDestsOfInstr (BL t _ _) = [ id | TBlock id <- [t]]
-aarch64_jumpDestsOfInstr (BCOND _ t) = [ id | TBlock id <- [t]]
-aarch64_jumpDestsOfInstr _ = []
+jumpDestsOfInstr :: Instr -> [BlockId]
+jumpDestsOfInstr (ANN _ i) = jumpDestsOfInstr i
+jumpDestsOfInstr (CBZ _ t) = [ id | TBlock id <- [t]]
+jumpDestsOfInstr (CBNZ _ t) = [ id | TBlock id <- [t]]
+jumpDestsOfInstr (J t) = [id | TBlock id <- [t]]
+jumpDestsOfInstr (B t) = [id | TBlock id <- [t]]
+jumpDestsOfInstr (BL t _ _) = [ id | TBlock id <- [t]]
+jumpDestsOfInstr (BCOND _ t) = [ id | TBlock id <- [t]]
+jumpDestsOfInstr _ = []
-- | Change the destination of this jump instruction.
-- Used in the linear allocator when adding fixup blocks for join
-- points.
-aarch64_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
-aarch64_patchJumpInstr instr patchF
+patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
+patchJumpInstr instr patchF
= case instr of
- ANN d i -> ANN d (aarch64_patchJumpInstr i patchF)
+ ANN d i -> ANN d (patchJumpInstr i patchF)
CBZ r (TBlock bid) -> CBZ r (TBlock (patchF bid))
CBNZ r (TBlock bid) -> CBNZ r (TBlock (patchF bid))
J (TBlock bid) -> J (TBlock (patchF bid))
@@ -356,7 +339,7 @@ aarch64_patchJumpInstr instr patchF
-- always poitns to the top of the stack, and we can't use it for computation.
--
-- | An instruction to spill a register into a spill slot.
-aarch64_mkSpillInstr
+mkSpillInstr
:: HasCallStack
=> NCGConfig
-> Reg -- register to spill
@@ -364,14 +347,14 @@ aarch64_mkSpillInstr
-> Int -- spill slot to use
-> [Instr]
-aarch64_mkSpillInstr config reg delta slot =
+mkSpillInstr config reg delta slot =
case (spillSlotToOffset config slot) - delta of
imm | -256 <= imm && imm <= 255 -> [ mkStrSp imm ]
imm | imm > 0 && imm .&. 0x7 == 0x0 && imm <= 0xfff -> [ mkStrSp imm ]
imm | imm > 0xfff && imm <= 0xffffff && imm .&. 0x7 == 0x0 -> [ mkIp0SpillAddr (imm .&~. 0xfff)
, mkStrIp0 (imm .&. 0xfff)
]
- imm -> pprPanic "aarch64_mkSpillInstr" (text "Unable to spill into" <+> int imm)
+ imm -> pprPanic "mkSpillInstr" (text "Unable to spill into" <+> int imm)
where
a .&~. b = a .&. (complement b)
@@ -384,21 +367,21 @@ aarch64_mkSpillInstr config reg delta slot =
off = spillSlotToOffset config slot
-aarch64_mkLoadInstr
+mkLoadInstr
:: NCGConfig
-> Reg -- register to load
-> Int -- current stack delta
-> Int -- spill slot to use
-> [Instr]
-aarch64_mkLoadInstr config reg delta slot =
+mkLoadInstr config reg delta slot =
case (spillSlotToOffset config slot) - delta of
imm | -256 <= imm && imm <= 255 -> [ mkLdrSp imm ]
imm | imm > 0 && imm .&. 0x7 == 0x0 && imm <= 0xfff -> [ mkLdrSp imm ]
imm | imm > 0xfff && imm <= 0xffffff && imm .&. 0x7 == 0x0 -> [ mkIp0SpillAddr (imm .&~. 0xfff)
, mkLdrIp0 (imm .&. 0xfff)
]
- imm -> pprPanic "aarch64_mkSpillInstr" (text "Unable to spill into" <+> int imm)
+ imm -> pprPanic "mkSpillInstr" (text "Unable to spill into" <+> int imm)
where
a .&~. b = a .&. (complement b)
@@ -414,16 +397,16 @@ aarch64_mkLoadInstr config reg delta slot =
--------------------------------------------------------------------------------
-- | See if this instruction is telling us the current C stack delta
-aarch64_takeDeltaInstr :: Instr -> Maybe Int
-aarch64_takeDeltaInstr (ANN _ i) = aarch64_takeDeltaInstr i
-aarch64_takeDeltaInstr (DELTA i) = Just i
-aarch64_takeDeltaInstr _ = Nothing
+takeDeltaInstr :: Instr -> Maybe Int
+takeDeltaInstr (ANN _ i) = takeDeltaInstr i
+takeDeltaInstr (DELTA i) = Just i
+takeDeltaInstr _ = Nothing
-- Not real instructions. Just meta data
-aarch64_isMetaInstr :: Instr -> Bool
-aarch64_isMetaInstr instr
+isMetaInstr :: Instr -> Bool
+isMetaInstr instr
= case instr of
- ANN _ i -> aarch64_isMetaInstr i
+ ANN _ i -> isMetaInstr i
COMMENT{} -> True
MULTILINE_COMMENT{} -> True
LOCATION{} -> True
@@ -436,32 +419,32 @@ aarch64_isMetaInstr instr
-- | Copy the value in a register to another one.
-- Must work for all register classes.
-aarch64_mkRegRegMoveInstr :: Reg -> Reg -> Instr
-aarch64_mkRegRegMoveInstr src dst = ANN (text $ "Reg->Reg Move: " ++ show src ++ " -> " ++ show dst) $ MOV (OpReg W64 dst) (OpReg W64 src)
+mkRegRegMoveInstr :: Reg -> Reg -> Instr
+mkRegRegMoveInstr src dst = ANN (text $ "Reg->Reg Move: " ++ show src ++ " -> " ++ show dst) $ MOV (OpReg W64 dst) (OpReg W64 src)
-- | Take the source and destination from this reg -> reg move instruction
-- or Nothing if it's not one
-aarch64_takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)
---aarch64_takeRegRegMoveInstr (MOV (OpReg fmt dst) (OpReg fmt' src)) | fmt == fmt' = Just (src, dst)
-aarch64_takeRegRegMoveInstr _ = Nothing
+takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)
+--takeRegRegMoveInstr (MOV (OpReg fmt dst) (OpReg fmt' src)) | fmt == fmt' = Just (src, dst)
+takeRegRegMoveInstr _ = Nothing
-- | Make an unconditional jump instruction.
-aarch64_mkJumpInstr :: BlockId -> [Instr]
-aarch64_mkJumpInstr id = [B (TBlock id)]
+mkJumpInstr :: BlockId -> [Instr]
+mkJumpInstr id = [B (TBlock id)]
-aarch64_mkStackAllocInstr :: Platform -> Int -> [Instr]
-aarch64_mkStackAllocInstr platform n
+mkStackAllocInstr :: Platform -> Int -> [Instr]
+mkStackAllocInstr platform n
| n == 0 = []
| n > 0 && n < 4096 = [ ANN (text "Alloc More Stack") $ SUB sp sp (OpImm (ImmInt n)) ]
- | n > 0 = ANN (text "Alloc More Stack") (SUB sp sp (OpImm (ImmInt 4095))) : aarch64_mkStackAllocInstr platform (n - 4095)
-aarch64_mkStackAllocInstr _platform n = pprPanic "aarch64_mkStackAllocInstr" (int n)
+ | n > 0 = ANN (text "Alloc More Stack") (SUB sp sp (OpImm (ImmInt 4095))) : mkStackAllocInstr platform (n - 4095)
+mkStackAllocInstr _platform n = pprPanic "mkStackAllocInstr" (int n)
-aarch64_mkStackDeallocInstr :: Platform -> Int -> [Instr]
-aarch64_mkStackDeallocInstr platform n
+mkStackDeallocInstr :: Platform -> Int -> [Instr]
+mkStackDeallocInstr platform n
| n == 0 = []
| n > 0 && n < 4096 = [ ANN (text "Dealloc More Stack") $ ADD sp sp (OpImm (ImmInt n)) ]
- | n > 0 = ANN (text "Dealloc More Stack") (ADD sp sp (OpImm (ImmInt 4095))) : aarch64_mkStackDeallocInstr platform (n - 4095)
-aarch64_mkStackDeallocInstr _platform n = pprPanic "aarch64_mkStackDeallocInstr" (int n)
+ | n > 0 = ANN (text "Dealloc More Stack") (ADD sp sp (OpImm (ImmInt 4095))) : mkStackDeallocInstr platform (n - 4095)
+mkStackDeallocInstr _platform n = pprPanic "mkStackDeallocInstr" (int n)
--
-- See note [extra spill slots] in X86/Instr.hs
@@ -502,8 +485,8 @@ allocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do
insert_dealloc insn r = case insn of
J _ -> dealloc ++ (insn : r)
ANN _ (J _) -> dealloc ++ (insn : r)
- _other | aarch64_jumpDestsOfInstr insn /= []
- -> aarch64_patchJumpInstr insn retarget : r
+ _other | jumpDestsOfInstr insn /= []
+ -> patchJumpInstr insn retarget : r
_other -> insn : r
where retarget b = fromMaybe b (mapLookup b new_blockmap)
=====================================
compiler/GHC/CmmToAsm/AArch64/Ppr.hs
=====================================
@@ -1,4 +1,6 @@
-module GHC.CmmToAsm.AArch64.Ppr (pprNatCmmDecl) where
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module GHC.CmmToAsm.AArch64.Ppr (pprNatCmmDecl, pprInstr) where
import GHC.Prelude hiding (EQ)
@@ -11,7 +13,6 @@ import GHC.CmmToAsm.AArch64.Instr
import GHC.CmmToAsm.AArch64.Regs
import GHC.CmmToAsm.AArch64.Cond
import GHC.CmmToAsm.Ppr
-import GHC.CmmToAsm.Instr hiding (pprInstr)
import GHC.CmmToAsm.Format
import GHC.Platform.Reg
import GHC.CmmToAsm.Config
=====================================
compiler/GHC/CmmToAsm/Instr.hs
=====================================
@@ -16,8 +16,6 @@ import GHC.Cmm.BlockId
import GHC.CmmToAsm.Config
-import GHC.Utils.Outputable (SDoc)
-
import GHC.Stack
-- | Holds a list of source and destination registers used by a
=====================================
compiler/ghc.cabal.in
=====================================
@@ -600,6 +600,7 @@ Library
GHC.CmmToAsm.X86.Cond
GHC.CmmToAsm.X86.Ppr
GHC.CmmToAsm.X86.CodeGen
+ GHC.CmmToAsm.AArch64
GHC.CmmToAsm.AArch64.Regs
GHC.CmmToAsm.AArch64.RegInfo
GHC.CmmToAsm.AArch64.Instr
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/64c698d8aa6d445d4192af17c9bb78afbf1440eb...e8060bf8b930ca2e384c588c83735bf146fed6b6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/64c698d8aa6d445d4192af17c9bb78afbf1440eb...e8060bf8b930ca2e384c588c83735bf146fed6b6
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200912/f178ae8b/attachment-0001.html>
More information about the ghc-commits
mailing list