{-# LANGUAGE CPP #-}
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.Utils.Panic
import GHC.Platform
import Data.Word
data FreeRegs
= FreeRegs
!Word32
!Word32
!Word32
instance Show FreeRegs where
show :: FreeRegs -> String
show = FreeRegs -> String
showFreeRegs
instance Outputable FreeRegs where
ppr :: FreeRegs -> SDoc
ppr = String -> SDoc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeRegs -> String
showFreeRegs
noFreeRegs :: FreeRegs
noFreeRegs :: FreeRegs
noFreeRegs = Word32 -> Word32 -> Word32 -> FreeRegs
FreeRegs Word32
0 Word32
0 Word32
0
initFreeRegs :: Platform -> FreeRegs
initFreeRegs :: Platform -> FreeRegs
initFreeRegs Platform
platform
= forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ Platform -> RealReg -> FreeRegs -> FreeRegs
releaseReg Platform
platform) FreeRegs
noFreeRegs [RealReg]
allocatableRegs
getFreeRegs :: RegClass -> FreeRegs -> [RealReg]
getFreeRegs :: RegClass -> FreeRegs -> [RealReg]
getFreeRegs RegClass
cls (FreeRegs Word32
g Word32
f Word32
d)
| RegClass
RcInteger <- RegClass
cls = forall a b. (a -> b) -> [a] -> [b]
map RegNo -> RealReg
RealRegSingle forall a b. (a -> b) -> a -> b
$ forall {t}. (Num t, Bits t) => RegNo -> t -> t -> RegNo -> [RegNo]
go RegNo
1 Word32
g Word32
1 RegNo
0
| RegClass
RcFloat <- RegClass
cls = forall a b. (a -> b) -> [a] -> [b]
map RegNo -> RealReg
RealRegSingle forall a b. (a -> b) -> a -> b
$ forall {t}. (Num t, Bits t) => RegNo -> t -> t -> RegNo -> [RegNo]
go RegNo
1 Word32
f Word32
1 RegNo
32
| RegClass
RcDouble <- RegClass
cls = forall a b. (a -> b) -> [a] -> [b]
map (\RegNo
i -> RegNo -> RegNo -> RealReg
RealRegPair RegNo
i (RegNo
iforall a. Num a => a -> a -> a
+RegNo
1)) forall a b. (a -> b) -> a -> b
$ forall {t}. (Num t, Bits t) => RegNo -> t -> t -> 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 -> t -> t -> RegNo -> [RegNo]
go RegNo
_ t
_ t
0 RegNo
_
= []
go RegNo
step t
bitmap t
mask RegNo
ix
| t
bitmap forall a. Bits a => a -> a -> a
.&. t
mask forall a. Eq a => a -> a -> Bool
/= t
0
= RegNo
ix forall a. a -> [a] -> [a]
: (RegNo -> t -> t -> RegNo -> [RegNo]
go RegNo
step t
bitmap (t
mask forall a. Bits a => a -> RegNo -> a
`shiftL` RegNo
step) forall a b. (a -> b) -> a -> b
$! RegNo
ix forall a. Num a => a -> a -> a
+ RegNo
step)
| Bool
otherwise
= RegNo -> t -> t -> RegNo -> [RegNo]
go RegNo
step t
bitmap (t
mask forall a. Bits a => a -> RegNo -> a
`shiftL` RegNo
step) forall a b. (a -> b) -> a -> b
$! RegNo
ix forall a. Num a => a -> a -> a
+ RegNo
step
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)
| Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Platform -> RegNo -> Bool
freeReg Platform
platform RegNo
r
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.FreeRegs.allocateReg: not allocating pinned reg" (forall a. Outputable a => a -> SDoc
ppr RealReg
reg)
| RegNo
r forall a. Ord a => a -> a -> Bool
<= RegNo
31
= let mask :: Word32
mask = forall a. Bits a => a -> a
complement (RegNo -> Word32
bitMask RegNo
r)
in Word32 -> Word32 -> Word32 -> FreeRegs
FreeRegs
(Word32
g forall a. Bits a => a -> a -> a
.&. Word32
mask)
Word32
f
Word32
d
| RegNo
r forall a. Ord a => a -> a -> Bool
>= RegNo
32, RegNo
r forall a. Ord a => a -> a -> Bool
<= RegNo
63
= let mask :: Word32
mask = forall a. Bits a => a -> a
complement (RegNo -> Word32
bitMask (RegNo
r forall a. Num a => a -> a -> a
- RegNo
32))
maskLow :: Word32
maskLow = if RegNo
r forall a. Integral a => a -> a -> a
`mod` RegNo
2 forall a. Eq a => a -> a -> Bool
== RegNo
0
then forall a. Bits a => a -> a
complement (RegNo -> Word32
bitMask (RegNo
r forall a. Num a => a -> a -> a
- RegNo
32))
else forall a. Bits a => a -> a
complement (RegNo -> Word32
bitMask (RegNo
r forall a. Num a => a -> a -> a
- RegNo
32 forall a. Num a => a -> a -> a
- RegNo
1))
in Word32 -> Word32 -> Word32 -> FreeRegs
FreeRegs
Word32
g
(Word32
f forall a. Bits a => a -> a -> a
.&. Word32
mask)
(Word32
d forall a. Bits a => a -> a -> a
.&. Word32
maskLow)
| Bool
otherwise
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.FreeRegs.releaseReg: not allocating bad reg" (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 forall a. Ord a => a -> a -> Bool
>= RegNo
32, RegNo
r1 forall a. Ord a => a -> a -> Bool
<= RegNo
63, RegNo
r1 forall a. Integral a => a -> a -> a
`mod` RegNo
2 forall a. Eq a => a -> a -> Bool
== RegNo
0
, RegNo
r2 forall a. Ord a => a -> a -> Bool
>= RegNo
32, RegNo
r2 forall a. Ord a => a -> a -> Bool
<= RegNo
63
= let mask1 :: Word32
mask1 = forall a. Bits a => a -> a
complement (RegNo -> Word32
bitMask (RegNo
r1 forall a. Num a => a -> a -> a
- RegNo
32))
mask2 :: Word32
mask2 = forall a. Bits a => a -> a
complement (RegNo -> Word32
bitMask (RegNo
r2 forall a. Num a => a -> a -> a
- RegNo
32))
in
Word32 -> Word32 -> Word32 -> FreeRegs
FreeRegs
Word32
g
((Word32
f forall a. Bits a => a -> a -> a
.&. Word32
mask1) forall a. Bits a => a -> a -> a
.&. Word32
mask2)
(Word32
d forall a. Bits a => a -> a -> a
.&. Word32
mask1)
| Bool
otherwise
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.FreeRegs.releaseReg: not allocating bad reg" (forall a. Outputable a => a -> SDoc
ppr RealReg
reg)
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)
| Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Platform -> RegNo -> Bool
freeReg Platform
platform RegNo
r
= FreeRegs
regs
| RegNo
r 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 forall a. Bits a => a -> a -> a
.|. Word32
mask) Word32
f Word32
d
| RegNo
r forall a. Ord a => a -> a -> Bool
>= RegNo
32, RegNo
r forall a. Ord a => a -> a -> Bool
<= RegNo
63
= let mask :: Word32
mask = RegNo -> Word32
bitMask (RegNo
r forall a. Num a => a -> a -> a
- RegNo
32)
maskLow :: Word32
maskLow = if RegNo
r forall a. Integral a => a -> a -> a
`mod` RegNo
2 forall a. Eq a => a -> a -> Bool
== RegNo
0
then RegNo -> Word32
bitMask (RegNo
r forall a. Num a => a -> a -> a
- RegNo
32)
else RegNo -> Word32
bitMask (RegNo
r forall a. Num a => a -> a -> a
- RegNo
32 forall a. Num a => a -> a -> a
- RegNo
1)
in Word32 -> Word32 -> Word32 -> FreeRegs
FreeRegs
Word32
g
(Word32
f forall a. Bits a => a -> a -> a
.|. Word32
mask)
(Word32
d forall a. Bits a => a -> a -> a
.|. Word32
maskLow)
| Bool
otherwise
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.FreeRegs.releaseReg: not releasing bad reg" (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 forall a. Ord a => a -> a -> Bool
>= RegNo
32, RegNo
r1 forall a. Ord a => a -> a -> Bool
<= RegNo
63, RegNo
r1 forall a. Integral a => a -> a -> a
`mod` RegNo
2 forall a. Eq a => a -> a -> Bool
== RegNo
0
, RegNo
r2 forall a. Ord a => a -> a -> Bool
>= RegNo
32, RegNo
r2 forall a. Ord a => a -> a -> Bool
<= RegNo
63
= let mask1 :: Word32
mask1 = RegNo -> Word32
bitMask (RegNo
r1 forall a. Num a => a -> a -> a
- RegNo
32)
mask2 :: Word32
mask2 = RegNo -> Word32
bitMask (RegNo
r2 forall a. Num a => a -> a -> a
- RegNo
32)
in
Word32 -> Word32 -> Word32 -> FreeRegs
FreeRegs
Word32
g
((Word32
f forall a. Bits a => a -> a -> a
.|. Word32
mask1) forall a. Bits a => a -> a -> a
.|. Word32
mask2)
(Word32
d forall a. Bits a => a -> a -> a
.|. Word32
mask1)
| Bool
otherwise
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.FreeRegs.releaseReg: not releasing bad reg" (forall a. Outputable a => a -> SDoc
ppr RealReg
reg)
bitMask :: Int -> Word32
bitMask :: RegNo -> Word32
bitMask RegNo
n = Word32
1 forall a. Bits a => a -> RegNo -> a
`shiftL` RegNo
n
showFreeRegs :: FreeRegs -> String
showFreeRegs :: FreeRegs -> String
showFreeRegs FreeRegs
regs
= String
"FreeRegs\n"
forall a. [a] -> [a] -> [a]
++ String
" integer: " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ RegClass -> FreeRegs -> [RealReg]
getFreeRegs RegClass
RcInteger FreeRegs
regs) forall a. [a] -> [a] -> [a]
++ String
"\n"
forall a. [a] -> [a] -> [a]
++ String
" float: " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ RegClass -> FreeRegs -> [RealReg]
getFreeRegs RegClass
RcFloat FreeRegs
regs) forall a. [a] -> [a] -> [a]
++ String
"\n"
forall a. [a] -> [a] -> [a]
++ String
" double: " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ RegClass -> FreeRegs -> [RealReg]
getFreeRegs RegClass
RcDouble FreeRegs
regs) forall a. [a] -> [a] -> [a]
++ String
"\n"