{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Free regs map for SPARC
module GHC.CmmToAsm.Reg.Linear.SPARC where

import GHC.Prelude

import GHC.CmmToAsm.SPARC.Regs
import GHC.Platform.Reg.Class
import GHC.Platform.Reg

import GHC.Platform.Regs
import GHC.Utils.Outputable
import GHC.Platform

import Data.Word
import Data.Bits


--------------------------------------------------------------------------------
-- SPARC is like PPC, except for twinning of floating point regs.
--      When we allocate a double reg we must take an even numbered
--      float reg, as well as the one after it.


-- Holds bitmaps showing what registers are currently allocated.
--      The float and double reg bitmaps overlap, but we only alloc
--      float regs into the float map, and double regs into the double map.
--
--      Free regs have a bit set in the corresponding bitmap.
--
data FreeRegs
        = FreeRegs
                !Word32         -- int    reg bitmap    regs  0..31
                !Word32         -- float  reg bitmap    regs 32..63
                !Word32         -- double reg bitmap    regs 32..63

instance Show FreeRegs where
        show :: FreeRegs -> String
show = FreeRegs -> String
showFreeRegs

instance Outputable FreeRegs where
        ppr :: FreeRegs -> SDoc
ppr = String -> SDoc
text (String -> SDoc) -> (FreeRegs -> String) -> FreeRegs -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeRegs -> String
showFreeRegs

-- | A reg map where no regs are free to be allocated.
noFreeRegs :: FreeRegs
noFreeRegs :: FreeRegs
noFreeRegs = Word32 -> Word32 -> Word32 -> FreeRegs
FreeRegs Word32
0 Word32
0 Word32
0


-- | The initial set of free regs.
initFreeRegs :: Platform -> FreeRegs
initFreeRegs :: Platform -> FreeRegs
initFreeRegs Platform
platform
 =      (FreeRegs -> RealReg -> FreeRegs)
-> FreeRegs -> [RealReg] -> FreeRegs
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((RealReg -> FreeRegs -> FreeRegs)
-> FreeRegs -> RealReg -> FreeRegs
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((RealReg -> FreeRegs -> FreeRegs)
 -> FreeRegs -> RealReg -> FreeRegs)
-> (RealReg -> FreeRegs -> FreeRegs)
-> FreeRegs
-> RealReg
-> FreeRegs
forall a b. (a -> b) -> a -> b
$ Platform -> RealReg -> FreeRegs -> FreeRegs
releaseReg Platform
platform) FreeRegs
noFreeRegs [RealReg]
allocatableRegs


-- | Get all the free registers of this class.
getFreeRegs :: RegClass -> FreeRegs -> [RealReg]        -- lazily
getFreeRegs :: RegClass -> FreeRegs -> [RealReg]
getFreeRegs RegClass
cls (FreeRegs Word32
g Word32
f Word32
d)
        | RegClass
RcInteger <- RegClass
cls = (RegNo -> RealReg) -> [RegNo] -> [RealReg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> RealReg
RealRegSingle                  ([RegNo] -> [RealReg]) -> [RegNo] -> [RealReg]
forall a b. (a -> b) -> a -> b
$ RegNo -> Word32 -> Word32 -> RegNo -> [RegNo]
forall {a}. (Num a, Bits a) => RegNo -> a -> a -> RegNo -> [RegNo]
go RegNo
1 Word32
g Word32
1 RegNo
0
        | RegClass
RcFloat   <- RegClass
cls = (RegNo -> RealReg) -> [RegNo] -> [RealReg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> RealReg
RealRegSingle                  ([RegNo] -> [RealReg]) -> [RegNo] -> [RealReg]
forall a b. (a -> b) -> a -> b
$ RegNo -> Word32 -> Word32 -> RegNo -> [RegNo]
forall {a}. (Num a, Bits a) => RegNo -> a -> a -> RegNo -> [RegNo]
go RegNo
1 Word32
f Word32
1 RegNo
32
        | RegClass
RcDouble  <- RegClass
cls = (RegNo -> RealReg) -> [RegNo] -> [RealReg]
forall a b. (a -> b) -> [a] -> [b]
map (\RegNo
i -> RegNo -> RegNo -> RealReg
RealRegPair RegNo
i (RegNo
iRegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
+RegNo
1))    ([RegNo] -> [RealReg]) -> [RegNo] -> [RealReg]
forall a b. (a -> b) -> a -> b
$ RegNo -> Word32 -> Word32 -> RegNo -> [RegNo]
forall {a}. (Num a, Bits a) => RegNo -> a -> a -> RegNo -> [RegNo]
go RegNo
2 Word32
d Word32
1 RegNo
32
#if __GLASGOW_HASKELL__ <= 810
        | otherwise = pprPanic "RegAllocLinear.getFreeRegs: Bad register class " (ppr cls)
#endif
        where
                go :: RegNo -> a -> a -> RegNo -> [RegNo]
go RegNo
_    a
_      a
0    RegNo
_
                        = []

                go RegNo
step a
bitmap a
mask RegNo
ix
                        | a
bitmap a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
mask a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0
                        = RegNo
ix RegNo -> [RegNo] -> [RegNo]
forall a. a -> [a] -> [a]
: (RegNo -> a -> a -> RegNo -> [RegNo]
go RegNo
step a
bitmap (a
mask a -> RegNo -> a
forall a. Bits a => a -> RegNo -> a
`shiftL` RegNo
step) (RegNo -> [RegNo]) -> RegNo -> [RegNo]
forall a b. (a -> b) -> a -> b
$! RegNo
ix RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
+ RegNo
step)

                        | Bool
otherwise
                        = RegNo -> a -> a -> RegNo -> [RegNo]
go RegNo
step a
bitmap (a
mask a -> RegNo -> a
forall a. Bits a => a -> RegNo -> a
`shiftL` RegNo
step) (RegNo -> [RegNo]) -> RegNo -> [RegNo]
forall a b. (a -> b) -> a -> b
$! RegNo
ix RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
+ RegNo
step


-- | Grab a register.
allocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
allocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
allocateReg Platform
platform
         reg :: RealReg
reg@(RealRegSingle RegNo
r)
             (FreeRegs Word32
g Word32
f Word32
d)

        -- can't allocate free regs
        | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Platform -> RegNo -> Bool
freeReg Platform
platform RegNo
r
        = String -> SDoc -> FreeRegs
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.FreeRegs.allocateReg: not allocating pinned reg" (RealReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealReg
reg)

        -- a general purpose reg
        | RegNo
r RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
<= RegNo
31
        = let   mask :: Word32
mask    = Word32 -> Word32
forall a. Bits a => a -> a
complement (RegNo -> Word32
bitMask RegNo
r)
          in    Word32 -> Word32 -> Word32 -> FreeRegs
FreeRegs
                        (Word32
g Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
mask)
                        Word32
f
                        Word32
d

        -- a float reg
        | RegNo
r RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= RegNo
32, RegNo
r RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
<= RegNo
63
        = let   mask :: Word32
mask    = Word32 -> Word32
forall a. Bits a => a -> a
complement (RegNo -> Word32
bitMask (RegNo
r RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
32))

                -- the mask of the double this FP reg aliases
                maskLow :: Word32
maskLow = if RegNo
r RegNo -> RegNo -> RegNo
forall a. Integral a => a -> a -> a
`mod` RegNo
2 RegNo -> RegNo -> Bool
forall a. Eq a => a -> a -> Bool
== RegNo
0
                                then Word32 -> Word32
forall a. Bits a => a -> a
complement (RegNo -> Word32
bitMask (RegNo
r RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
32))
                                else Word32 -> Word32
forall a. Bits a => a -> a
complement (RegNo -> Word32
bitMask (RegNo
r RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
32 RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
1))
          in    Word32 -> Word32 -> Word32 -> FreeRegs
FreeRegs
                        Word32
g
                        (Word32
f Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
mask)
                        (Word32
d Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
maskLow)

        | Bool
otherwise
        = String -> SDoc -> FreeRegs
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.FreeRegs.releaseReg: not allocating bad reg" (RealReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealReg
reg)

allocateReg Platform
_
         reg :: RealReg
reg@(RealRegPair RegNo
r1 RegNo
r2)
             (FreeRegs Word32
g Word32
f Word32
d)

        | RegNo
r1 RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= RegNo
32, RegNo
r1 RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
<= RegNo
63, RegNo
r1 RegNo -> RegNo -> RegNo
forall a. Integral a => a -> a -> a
`mod` RegNo
2 RegNo -> RegNo -> Bool
forall a. Eq a => a -> a -> Bool
== RegNo
0
        , RegNo
r2 RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= RegNo
32, RegNo
r2 RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
<= RegNo
63
        = let   mask1 :: Word32
mask1   = Word32 -> Word32
forall a. Bits a => a -> a
complement (RegNo -> Word32
bitMask (RegNo
r1 RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
32))
                mask2 :: Word32
mask2   = Word32 -> Word32
forall a. Bits a => a -> a
complement (RegNo -> Word32
bitMask (RegNo
r2 RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
32))
          in
                Word32 -> Word32 -> Word32 -> FreeRegs
FreeRegs
                        Word32
g
                        ((Word32
f Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
mask1) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
mask2)
                        (Word32
d Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
mask1)

        | Bool
otherwise
        = String -> SDoc -> FreeRegs
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.FreeRegs.releaseReg: not allocating bad reg" (RealReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealReg
reg)



-- | Release a register from allocation.
--      The register liveness information says that most regs die after a C call,
--      but we still don't want to allocate to some of them.
--
releaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
releaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
releaseReg Platform
platform
         reg :: RealReg
reg@(RealRegSingle RegNo
r)
        regs :: FreeRegs
regs@(FreeRegs Word32
g Word32
f Word32
d)

        -- don't release pinned reg
        | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Platform -> RegNo -> Bool
freeReg Platform
platform RegNo
r
        = FreeRegs
regs

        -- a general purpose reg
        | RegNo
r RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
<= RegNo
31
        = let   mask :: Word32
mask    = RegNo -> Word32
bitMask RegNo
r
          in    Word32 -> Word32 -> Word32 -> FreeRegs
FreeRegs (Word32
g Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
mask) Word32
f Word32
d

        -- a float reg
        | RegNo
r RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= RegNo
32, RegNo
r RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
<= RegNo
63
        = let   mask :: Word32
mask    = RegNo -> Word32
bitMask (RegNo
r RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
32)

                -- the mask of the double this FP reg aliases
                maskLow :: Word32
maskLow = if RegNo
r RegNo -> RegNo -> RegNo
forall a. Integral a => a -> a -> a
`mod` RegNo
2 RegNo -> RegNo -> Bool
forall a. Eq a => a -> a -> Bool
== RegNo
0
                                then RegNo -> Word32
bitMask (RegNo
r RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
32)
                                else RegNo -> Word32
bitMask (RegNo
r RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
32 RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
1)
          in    Word32 -> Word32 -> Word32 -> FreeRegs
FreeRegs
                        Word32
g
                        (Word32
f Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
mask)
                        (Word32
d Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
maskLow)

        | Bool
otherwise
        = String -> SDoc -> FreeRegs
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.FreeRegs.releaseReg: not releasing bad reg" (RealReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealReg
reg)

releaseReg Platform
_
         reg :: RealReg
reg@(RealRegPair RegNo
r1 RegNo
r2)
             (FreeRegs Word32
g Word32
f Word32
d)

        | RegNo
r1 RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= RegNo
32, RegNo
r1 RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
<= RegNo
63, RegNo
r1 RegNo -> RegNo -> RegNo
forall a. Integral a => a -> a -> a
`mod` RegNo
2 RegNo -> RegNo -> Bool
forall a. Eq a => a -> a -> Bool
== RegNo
0
        , RegNo
r2 RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= RegNo
32, RegNo
r2 RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
<= RegNo
63
        = let   mask1 :: Word32
mask1   = RegNo -> Word32
bitMask (RegNo
r1 RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
32)
                mask2 :: Word32
mask2   = RegNo -> Word32
bitMask (RegNo
r2 RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
32)
          in
                Word32 -> Word32 -> Word32 -> FreeRegs
FreeRegs
                        Word32
g
                        ((Word32
f Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
mask1) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
mask2)
                        (Word32
d Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
mask1)

        | Bool
otherwise
        = String -> SDoc -> FreeRegs
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.FreeRegs.releaseReg: not releasing bad reg" (RealReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealReg
reg)



bitMask :: Int -> Word32
bitMask :: RegNo -> Word32
bitMask RegNo
n       = Word32
1 Word32 -> RegNo -> Word32
forall a. Bits a => a -> RegNo -> a
`shiftL` RegNo
n


showFreeRegs :: FreeRegs -> String
showFreeRegs :: FreeRegs -> String
showFreeRegs FreeRegs
regs
        =  String
"FreeRegs\n"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"    integer: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([RealReg] -> String
forall a. Show a => a -> String
show ([RealReg] -> String) -> [RealReg] -> String
forall a b. (a -> b) -> a -> b
$ RegClass -> FreeRegs -> [RealReg]
getFreeRegs RegClass
RcInteger FreeRegs
regs)       String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"      float: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([RealReg] -> String
forall a. Show a => a -> String
show ([RealReg] -> String) -> [RealReg] -> String
forall a b. (a -> b) -> a -> b
$ RegClass -> FreeRegs -> [RealReg]
getFreeRegs RegClass
RcFloat   FreeRegs
regs)       String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"     double: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([RealReg] -> String
forall a. Show a => a -> String
show ([RealReg] -> String) -> [RealReg] -> String
forall a b. (a -> b) -> a -> b
$ RegClass -> FreeRegs -> [RealReg]
getFreeRegs RegClass
RcDouble  FreeRegs
regs)       String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"