[Git][ghc/ghc][wip/T14586] Initial commit of ARM module hierarchy and skeleton.

dmjio gitlab at gitlab.haskell.org
Tue Jun 23 18:21:21 UTC 2020



dmjio pushed to branch wip/T14586 at Glasgow Haskell Compiler / GHC


Commits:
f1481b15 by David Johnson at 2020-06-23T14:21:11-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         = arm_regUsageOfInstr
+  patchRegsOfInstr        = arm_patchRegsOfInstr
+  isJumpishInstr          = arm_isJumpishInstr
+  jumpDestsOfInstr        = arm_jumpDestsOfInstr
+  patchJumpInstr          = arm_patchJumpInstr
+  mkSpillInstr            = arm_mkSpillInstr
+  mkLoadInstr             = arm_mkLoadInstr
+  takeDeltaInstr          = arm_takeDeltaInstr
+  isMetaInstr             = arm_isMetaInstr
+  mkRegRegMoveInstr _     = arm_mkRegRegMoveInstr
+  takeRegRegMoveInstr     = arm_takeRegRegMoveInstr
+  mkJumpInstr             = arm_mkJumpInstr
+  mkStackAllocInstr       = arm_mkStackAllocInstr
+  mkStackDeallocInstr     = arm_mkStackDeallocInstr
+
+arm_regUsageOfInstr :: Platform -> Instr -> RegUsage
+arm_regUsageOfInstr = undefined
+
+arm_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
+arm_patchRegsOfInstr = undefined
+
+arm_isJumpishInstr :: Instr -> Bool
+arm_isJumpishInstr = undefined
+
+arm_jumpDestsOfInstr :: Instr -> [BlockId]
+arm_jumpDestsOfInstr = undefined
+
+arm_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
+arm_patchJumpInstr = undefined
+
+arm_mkSpillInstr :: NCGConfig -> Reg -> Int -> Int -> Instr
+arm_mkSpillInstr = undefined
+
+arm_mkLoadInstr :: NCGConfig -> Reg -> Int -> Int -> Instr
+arm_mkLoadInstr = undefined
+
+arm_takeDeltaInstr :: Instr -> Maybe Int
+arm_takeDeltaInstr = undefined
+
+arm_isMetaInstr :: Instr -> Bool
+arm_isMetaInstr = undefined
+
+arm_mkRegRegMoveInstr :: Reg -> Reg -> Instr
+arm_mkRegRegMoveInstr = undefined
+
+arm_takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg)
+arm_takeRegRegMoveInstr = undefined
+
+arm_mkJumpInstr :: BlockId -> [Instr]
+arm_mkJumpInstr = undefined
+
+arm_mkStackAllocInstr :: Platform -> Int -> [Instr]
+arm_mkStackAllocInstr = undefined
+
+arm_mkStackDeallocInstr :: Platform -> Int -> [Instr]
+arm_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/f1481b1586bcfb7c1452e677c5b5b3a99bffda08

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f1481b1586bcfb7c1452e677c5b5b3a99bffda08
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/10b45e3e/attachment-0001.html>


More information about the ghc-commits mailing list