[Git][ghc/ghc][wip/T14586] Initial commit of ARM module hierarchy and skeleton.
dmjio
gitlab at gitlab.haskell.org
Tue Jun 23 18:19:53 UTC 2020
dmjio pushed to branch wip/T14586 at Glasgow Haskell Compiler / GHC
Commits:
b4dcf6ed by David Johnson at 2020-06-23T14:16:47-04:00
Initial commit of ARM module hierarchy and skeleton.
- - - - -
8 changed files:
- compiler/GHC/CmmToAsm.hs
- + compiler/GHC/CmmToAsm/ARM/CodeGen.hs
- + compiler/GHC/CmmToAsm/ARM/Cond.hs
- + compiler/GHC/CmmToAsm/ARM/Instr.hs
- + compiler/GHC/CmmToAsm/ARM/Ppr.hs
- + compiler/GHC/CmmToAsm/ARM/RegInfo.hs
- + compiler/GHC/CmmToAsm/ARM/Regs.hs
- compiler/ghc.cabal.in
Changes:
=====================================
compiler/GHC/CmmToAsm.hs
=====================================
@@ -50,6 +50,12 @@ 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 qualified GHC.CmmToAsm.ARM.CodeGen as ARM.CodeGen
+import qualified GHC.CmmToAsm.ARM.Regs as ARM.Regs
+import qualified GHC.CmmToAsm.ARM.RegInfo as ARM.RegInfo
+import qualified GHC.CmmToAsm.ARM.Instr as ARM.Instr
+import qualified GHC.CmmToAsm.ARM.Ppr as ARM.Ppr
+
import GHC.CmmToAsm.Reg.Liveness
import qualified GHC.CmmToAsm.Reg.Linear as Linear
@@ -176,7 +182,7 @@ nativeCodeGen dflags this_mod modLoc h us cmms
ArchSPARC -> nCG' (sparcNcgImpl config)
ArchSPARC64 -> panic "nativeCodeGen: No NCG for SPARC64"
ArchARM {} -> panic "nativeCodeGen: No NCG for ARM"
- ArchARM64 -> panic "nativeCodeGen: No NCG for ARM64"
+ ArchARM64 -> nCG' (arm64NcgImpl config)
ArchPPC_64 _ -> nCG' (ppcNcgImpl config)
ArchAlpha -> panic "nativeCodeGen: No NCG for Alpha"
ArchMipseb -> panic "nativeCodeGen: No NCG for mipseb"
@@ -212,6 +218,28 @@ x86_64NcgImpl config
where
platform = ncgPlatform config
+arm64NcgImpl :: NCGConfig -> NcgImpl RawCmmStatics ARM.Instr.Instr ARM.RegInfo.JumpDest
+arm64NcgImpl config
+ = NcgImpl {
+ ncgConfig = config
+ ,cmmTopCodeGen = ARM.CodeGen.cmmTopCodeGen
+ ,generateJumpTableForInstr = ARM.CodeGen.generateJumpTableForInstr config
+ ,getJumpDestBlockId = ARM.RegInfo.getJumpDestBlockId
+ ,canShortcut = ARM.RegInfo.canShortcut
+ ,shortcutStatics = ARM.RegInfo.shortcutStatics
+ ,shortcutJump = ARM.RegInfo.shortcutJump
+ ,pprNatCmmDecl = ARM.Ppr.pprNatCmmDecl config
+ ,maxSpillSlots = ARM.Instr.maxSpillSlots config
+ ,allocatableRegs = ARM.Regs.allocatableRegs platform
+ ,ncgAllocMoreStack = ARM.Instr.allocMoreStack platform
+ ,ncgExpandTop = id
+ ,ncgMakeFarBranches = ARM.Instr.makeFarBranches
+ ,extractUnwindPoints = const []
+ ,invertCondBranches = \_ _ -> id
+ }
+ where
+ platform = ncgPlatform config
+
ppcNcgImpl :: NCGConfig -> NcgImpl RawCmmStatics PPC.Instr.Instr PPC.RegInfo.JumpDest
ppcNcgImpl config
= NcgImpl {
=====================================
compiler/GHC/CmmToAsm/ARM/CodeGen.hs
=====================================
@@ -0,0 +1,26 @@
+{-# LANGUAGE CPP, GADTs #-}
+module GHC.CmmToAsm.ARM.CodeGen
+ ( cmmTopCodeGen
+ , generateJumpTableForInstr
+ , InstrBlock
+ ) where
+
+#include "HsVersions.h"
+
+import GHC.CmmToAsm.Monad (NatM)
+import GHC.CmmToAsm.Instr
+import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.ARM.Instr
+import GHC.Prelude
+import GHC.Cmm
+
+cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl RawCmmStatics Instr]
+cmmTopCodeGen = undefined
+
+generateJumpTableForInstr
+ :: NCGConfig
+ -> Instr
+ -> Maybe (NatCmmDecl RawCmmStatics Instr)
+generateJumpTableForInstr = undefined
+
+data InstrBlock
=====================================
compiler/GHC/CmmToAsm/ARM/Cond.hs
=====================================
@@ -0,0 +1,42 @@
+module GHC.CmmToAsm.ARM.Cond
+ ( Cond (..)
+ , condNegate
+ , condUnsigned
+ ) where
+
+import GHC.Prelude
+import GHC.Utils.Panic
+
+data Cond
+ = ALWAYS
+ | EQQ
+ | GE
+ | GEU
+ | GTT
+ | GU
+ | LE
+ | LEU
+ | LTT
+ | LU
+ | NE
+ deriving Eq
+
+condNegate :: Cond -> Cond
+condNegate ALWAYS = panic "condNegate: ALWAYS"
+condNegate EQQ = NE
+condNegate GE = LTT
+condNegate GEU = LU
+condNegate GTT = LE
+condNegate GU = LEU
+condNegate LE = GTT
+condNegate LEU = GU
+condNegate LTT = GE
+condNegate LU = GEU
+condNegate NE = EQQ
+
+condUnsigned :: Cond -> Bool
+condUnsigned GU = True
+condUnsigned LU = True
+condUnsigned GEU = True
+condUnsigned LEU = True
+condUnsigned _ = False
=====================================
compiler/GHC/CmmToAsm/ARM/Instr.hs
=====================================
@@ -0,0 +1,115 @@
+module GHC.CmmToAsm.ARM.Instr where
+
+import GHC.Cmm
+import GHC.Cmm.BlockId
+import GHC.Cmm.Dataflow.Label
+import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.Instr
+import GHC.Cmm.CLabel
+import GHC.Platform
+import GHC.Platform.Reg
+import GHC.Prelude
+import GHC.Types.Unique.Supply
+import GHC.Utils.Outputable
+
+instance Outputable Instr where
+ ppr = undefined
+
+data Imm
+ = ImmInt Int
+ | ImmInteger Integer -- Sigh.
+ | ImmCLbl CLabel -- AbstractC Label (with baggage)
+ | ImmLit SDoc -- Simple string
+ | ImmIndex CLabel Int
+ | ImmFloat Rational
+ | ImmDouble Rational
+ | ImmConstantSum Imm Imm
+ | ImmConstantDiff Imm Imm
+ | LO Imm
+ | HI Imm
+ | HA Imm {- high halfword adjusted -}
+ | HIGHERA Imm
+ | HIGHESTA Imm
+
+data RI
+ = RIReg Reg
+ | RIImm Imm
+
+data Instr
+ = Add Reg Reg RI
+
+instance Instruction Instr where
+ regUsageOfInstr = arm64_regUsageOfInstr
+ patchRegsOfInstr = arm64_patchRegsOfInstr
+ isJumpishInstr = arm64_isJumpishInstr
+ jumpDestsOfInstr = arm64_jumpDestsOfInstr
+ patchJumpInstr = arm64_patchJumpInstr
+ mkSpillInstr = arm64_mkSpillInstr
+ mkLoadInstr = arm64_mkLoadInstr
+ takeDeltaInstr = arm64_takeDeltaInstr
+ isMetaInstr = arm64_isMetaInstr
+ mkRegRegMoveInstr _ = arm64_mkRegRegMoveInstr
+ takeRegRegMoveInstr = arm64_takeRegRegMoveInstr
+ mkJumpInstr = arm64_mkJumpInstr
+ mkStackAllocInstr = arm64_mkStackAllocInstr
+ mkStackDeallocInstr = arm64_mkStackDeallocInstr
+
+arm64_regUsageOfInstr :: Platform -> Instr -> RegUsage
+arm64_regUsageOfInstr = undefined
+
+arm64_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
+arm64_patchRegsOfInstr = undefined
+
+arm64_isJumpishInstr :: Instr -> Bool
+arm64_isJumpishInstr = undefined
+
+arm64_jumpDestsOfInstr :: Instr -> [BlockId]
+arm64_jumpDestsOfInstr = undefined
+
+arm64_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
+arm64_patchJumpInstr = undefined
+
+arm64_mkSpillInstr :: NCGConfig -> Reg -> Int -> Int -> Instr
+arm64_mkSpillInstr = undefined
+
+arm64_mkLoadInstr :: NCGConfig -> Reg -> Int -> Int -> Instr
+arm64_mkLoadInstr = undefined
+
+arm64_takeDeltaInstr :: Instr -> Maybe Int
+arm64_takeDeltaInstr = undefined
+
+arm64_isMetaInstr :: Instr -> Bool
+arm64_isMetaInstr = undefined
+
+arm64_mkRegRegMoveInstr :: Reg -> Reg -> Instr
+arm64_mkRegRegMoveInstr = undefined
+
+arm64_takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg)
+arm64_takeRegRegMoveInstr = undefined
+
+arm64_mkJumpInstr :: BlockId -> [Instr]
+arm64_mkJumpInstr = undefined
+
+arm64_mkStackAllocInstr :: Platform -> Int -> [Instr]
+arm64_mkStackAllocInstr = undefined
+
+arm64_mkStackDeallocInstr :: Platform -> Int -> [Instr]
+arm64_mkStackDeallocInstr = undefined
+
+maxSpillSlots :: NCGConfig -> Int
+maxSpillSlots = undefined
+
+allocMoreStack
+ :: Platform
+ -> Int
+ -> NatCmmDecl RawCmmStatics Instr
+ -> UniqSM (NatCmmDecl RawCmmStatics Instr, [(BlockId, BlockId)])
+allocMoreStack = undefined
+
+makeFarBranches
+ :: LabelMap RawCmmStatics
+ -> [NatBasicBlock Instr]
+ -> [NatBasicBlock Instr]
+makeFarBranches = undefined
+
+
=====================================
compiler/GHC/CmmToAsm/ARM/Ppr.hs
=====================================
@@ -0,0 +1,15 @@
+module GHC.CmmToAsm.ARM.Ppr (pprNatCmmDecl) where
+
+import GHC.Prelude
+import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.Instr
+import GHC.CmmToAsm.ARM.Instr
+import GHC.Cmm
+import GHC.Utils.Outputable
+
+pprNatCmmDecl
+ :: NCGConfig
+ -> NatCmmDecl RawCmmStatics Instr
+ -> SDoc
+pprNatCmmDecl = undefined
+
=====================================
compiler/GHC/CmmToAsm/ARM/RegInfo.hs
=====================================
@@ -0,0 +1,66 @@
+{-# LANGUAGE CPP #-}
+module GHC.CmmToAsm.ARM.RegInfo
+ ( JumpDest( DestBlockId )
+ , getJumpDestBlockId
+ , canShortcut
+ , shortcutJump
+ , shortcutStatics
+ ) where
+
+#include "HsVersions.h"
+
+import GHC.Cmm
+import GHC.Cmm.BlockId
+import GHC.Cmm.CLabel
+import GHC.CmmToAsm.ARM.Instr
+import GHC.Prelude
+import GHC.Types.Unique
+import GHC.Utils.Outputable (ppr, text, Outputable)
+
+data JumpDest = DestBlockId BlockId
+
+-- Debug Instance
+instance Outputable JumpDest where
+ ppr (DestBlockId _) = text "TODO: implement me"
+
+getJumpDestBlockId :: JumpDest -> Maybe BlockId
+getJumpDestBlockId (DestBlockId bid) = Just bid
+
+canShortcut :: Instr -> Maybe JumpDest
+canShortcut _ = Nothing
+
+shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
+shortcutJump _ other = other
+
+-- Here because it knows about JumpDest
+shortcutStatics :: (BlockId -> Maybe JumpDest) -> RawCmmStatics -> RawCmmStatics
+shortcutStatics fn (CmmStaticsRaw lbl statics)
+ = CmmStaticsRaw lbl $ map (shortcutStatic fn) statics
+ -- we need to get the jump tables, so apply the mapping to the entries
+ -- of a CmmData too.
+
+shortcutLabel :: (BlockId -> Maybe JumpDest) -> CLabel -> CLabel
+shortcutLabel fn lab
+ | Just blkId <- maybeLocalBlockLabel lab = shortBlockId fn blkId
+ | otherwise = lab
+
+shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
+shortcutStatic fn (CmmStaticLit (CmmLabel lab))
+ = CmmStaticLit (CmmLabel (shortcutLabel fn lab))
+shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off w))
+ = CmmStaticLit (CmmLabelDiffOff (shortcutLabel fn lbl1) lbl2 off w)
+ -- slightly dodgy, we're ignoring the second label, but this
+ -- works with the way we use CmmLabelDiffOff for jump tables now.
+shortcutStatic _ other_static
+ = other_static
+
+shortBlockId
+ :: (BlockId -> Maybe JumpDest)
+ -> BlockId
+ -> CLabel
+
+shortBlockId fn blockid =
+ case fn blockid of
+ Nothing -> mkLocalBlockLabel uq
+ Just (DestBlockId blockid') -> shortBlockId fn blockid'
+ where uq = getUnique blockid
=====================================
compiler/GHC/CmmToAsm/ARM/Regs.hs
=====================================
@@ -0,0 +1,8 @@
+module GHC.CmmToAsm.ARM.Regs where
+
+import GHC.Prelude
+import GHC.Platform
+import GHC.Platform.Reg
+
+allocatableRegs :: Platform -> [RealReg]
+allocatableRegs = const []
=====================================
compiler/ghc.cabal.in
=====================================
@@ -582,6 +582,11 @@ Library
GHC.CmmToAsm.X86.Cond
GHC.CmmToAsm.X86.Ppr
GHC.CmmToAsm.X86.CodeGen
+ GHC.CmmToAsm.ARM.Regs
+ GHC.CmmToAsm.ARM.RegInfo
+ GHC.CmmToAsm.ARM.Instr
+ GHC.CmmToAsm.ARM.Cond
+ GHC.CmmToAsm.ARM.Ppr
GHC.CmmToAsm.PPC.Regs
GHC.CmmToAsm.PPC.RegInfo
GHC.CmmToAsm.PPC.Instr
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4dcf6eda62bded7309b7b2ffc6a5cde96b7641d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4dcf6eda62bded7309b7b2ffc6a5cde96b7641d
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/20200623/5052e806/attachment-0001.html>
More information about the ghc-commits
mailing list