[Git][ghc/ghc][wip/T14586] Add linear allocator module.

[dmjio]

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


Commits:
bf1414a4 by David Johnson at 2020-06-28T03:39:58+00:00
Add linear allocator module.

- - - - -


4 changed files:

- compiler/GHC/CmmToAsm/Reg/Linear.hs
- + compiler/GHC/CmmToAsm/Reg/Linear/ARM.hs
- compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs
- compiler/ghc.cabal.in


Changes:

=====================================
compiler/GHC/CmmToAsm/Reg/Linear.hs
=====================================
@@ -113,6 +113,7 @@ import GHC.CmmToAsm.Reg.Linear.StackMap
 import GHC.CmmToAsm.Reg.Linear.FreeRegs
 import GHC.CmmToAsm.Reg.Linear.Stats
 import GHC.CmmToAsm.Reg.Linear.JoinToTargets
+import qualified GHC.CmmToAsm.Reg.Linear.ARM    as ARM
 import qualified GHC.CmmToAsm.Reg.Linear.PPC    as PPC
 import qualified GHC.CmmToAsm.Reg.Linear.SPARC  as SPARC
 import qualified GHC.CmmToAsm.Reg.Linear.X86    as X86
@@ -220,7 +221,7 @@ linearRegAlloc config entry_ids block_live sccs
       ArchSPARC64    -> panic "linearRegAlloc ArchSPARC64"
       ArchPPC        -> go $ (frInitFreeRegs platform :: PPC.FreeRegs)
       ArchARM _ _ _  -> panic "linearRegAlloc ArchARM"
-      ArchARM64      -> panic "linearRegAlloc ArchARM64"
+      ArchARM64      -> go $ (frInitFreeRegs platform :: ARM.FreeRegs)
       ArchPPC_64 _   -> go $ (frInitFreeRegs platform :: PPC.FreeRegs)
       ArchAlpha      -> panic "linearRegAlloc ArchAlpha"
       ArchMipseb     -> panic "linearRegAlloc ArchMipseb"


=====================================
compiler/GHC/CmmToAsm/Reg/Linear/ARM.hs
=====================================
@@ -0,0 +1,52 @@
+module GHC.CmmToAsm.Reg.Linear.ARM where
+
+import GHC.Prelude
+
+import GHC.CmmToAsm.PPC.Regs
+import GHC.Platform.Reg.Class
+import GHC.Platform.Reg
+
+import GHC.Utils.Outputable
+import GHC.Platform
+
+import Data.Word
+import Data.Bits
+
+-- ARM has 32 registers.
+data FreeRegs = FreeRegs !Word32
+              deriving( Show )  -- The Show is used in an ASSERT
+
+instance Outputable FreeRegs where
+    ppr = text . show
+
+noFreeRegs :: FreeRegs
+noFreeRegs = FreeRegs 0
+
+releaseReg :: RealReg -> FreeRegs -> FreeRegs
+releaseReg (RealRegSingle r) (FreeRegs f)
+    | r > 31    = FreeRegs (f .|. (1 `shiftL` (r - 32)))
+    | otherwise = FreeRegs (f .|. (1 `shiftL` r))
+
+releaseReg _ _
+        = panic "RegAlloc.Linear.AR<.releaseReg: bad reg"
+
+initFreeRegs :: Platform -> FreeRegs
+initFreeRegs platform =
+  foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)
+
+getFreeRegs :: RegClass -> FreeRegs -> [RealReg]        -- lazily
+getFreeRegs cls (FreeRegs f)
+    | RcInteger <- cls = go f (0x80000000) 31
+    | otherwise = pprPanic "RegAllocLinear.getFreeRegs: Bad register class" (ppr cls)
+    where
+        go _ 0 _ = []
+        go x m i | x .&. m /= 0 = RealRegSingle i : (go x (m `shiftR` 1) $! i-1)
+                 | otherwise    = go x (m `shiftR` 1) $! i-1
+
+allocateReg :: RealReg -> FreeRegs -> FreeRegs
+allocateReg (RealRegSingle r) (FreeRegs f)
+    | r > 31    = FreeRegs (f .&. complement (1 `shiftL` (r - 32)))
+    | otherwise = FreeRegs (f .&. complement (1 `shiftL` r))
+
+allocateReg _ _
+        = panic "RegAlloc.Linear.PPC.allocateReg: bad reg"


=====================================
compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs
=====================================
@@ -30,11 +30,13 @@ import GHC.Platform
 --      getFreeRegs cls f = filter ( (==cls) . regClass . RealReg ) f
 --      allocateReg f r = filter (/= r) f
 
+import qualified GHC.CmmToAsm.Reg.Linear.ARM    as ARM
 import qualified GHC.CmmToAsm.Reg.Linear.PPC    as PPC
 import qualified GHC.CmmToAsm.Reg.Linear.SPARC  as SPARC
 import qualified GHC.CmmToAsm.Reg.Linear.X86    as X86
 import qualified GHC.CmmToAsm.Reg.Linear.X86_64 as X86_64
 
+import qualified GHC.CmmToAsm.ARM.Instr   as ARM.Instr
 import qualified GHC.CmmToAsm.PPC.Instr   as PPC.Instr
 import qualified GHC.CmmToAsm.SPARC.Instr as SPARC.Instr
 import qualified GHC.CmmToAsm.X86.Instr   as X86.Instr
@@ -57,6 +59,12 @@ instance FR X86_64.FreeRegs where
     frInitFreeRegs = X86_64.initFreeRegs
     frReleaseReg   = \_ -> X86_64.releaseReg
 
+instance FR ARM.FreeRegs where
+    frAllocateReg  = \_ -> ARM.allocateReg
+    frGetFreeRegs  = \_ -> ARM.getFreeRegs
+    frInitFreeRegs = ARM.initFreeRegs
+    frReleaseReg   = \_ -> ARM.releaseReg
+
 instance FR PPC.FreeRegs where
     frAllocateReg  = \_ -> PPC.allocateReg
     frGetFreeRegs  = \_ -> PPC.getFreeRegs
@@ -78,7 +86,7 @@ maxSpillSlots config = case platformArch (ncgPlatform config) of
    ArchSPARC     -> SPARC.Instr.maxSpillSlots config
    ArchSPARC64   -> panic "maxSpillSlots ArchSPARC64"
    ArchARM _ _ _ -> panic "maxSpillSlots ArchARM"
-   ArchARM64     -> panic "maxSpillSlots ArchARM64"
+   ArchARM64     -> ARM.Instr.maxSpillSlots config
    ArchPPC_64 _  -> PPC.Instr.maxSpillSlots config
    ArchAlpha     -> panic "maxSpillSlots ArchAlpha"
    ArchMipseb    -> panic "maxSpillSlots ArchMipseb"


=====================================
compiler/ghc.cabal.in
=====================================
@@ -627,6 +627,7 @@ Library
             GHC.CmmToAsm.Reg.Linear.FreeRegs
             GHC.CmmToAsm.Reg.Linear.StackMap
             GHC.CmmToAsm.Reg.Linear.Base
+            GHC.CmmToAsm.Reg.Linear.ARM
             GHC.CmmToAsm.Reg.Linear.X86
             GHC.CmmToAsm.Reg.Linear.X86_64
             GHC.CmmToAsm.Reg.Linear.PPC



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf1414a4f341c75d65cad9cf5bb6d0858aaeac1f

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