module RegAlloc.Linear.SPARC.FreeRegs
where
import GhcPrelude
import SPARC.Regs
import RegClass
import Reg
import GHC.Platform.Regs
import Outputable
import GHC.Platform
import Data.Word
import Data.Bits
data FreeRegs
= FreeRegs
!Word32
!Word32
!Word32
instance Show FreeRegs where
show :: FreeRegs -> String
show = 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
= (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
getFreeRegs :: RegClass -> FreeRegs -> [RealReg]
getFreeRegs :: RegClass -> FreeRegs -> [RealReg]
getFreeRegs RegClass
cls (FreeRegs Word32
g Word32
f Word32
d)
| RegClass
RcInteger <- RegClass
cls = (Int -> RealReg) -> [Int] -> [RealReg]
forall a b. (a -> b) -> [a] -> [b]
map Int -> RealReg
RealRegSingle ([Int] -> [RealReg]) -> [Int] -> [RealReg]
forall a b. (a -> b) -> a -> b
$ Int -> Word32 -> Word32 -> Int -> [Int]
forall a. (Num a, Bits a) => Int -> a -> a -> Int -> [Int]
go Int
1 Word32
g Word32
1 Int
0
| RegClass
RcFloat <- RegClass
cls = (Int -> RealReg) -> [Int] -> [RealReg]
forall a b. (a -> b) -> [a] -> [b]
map Int -> RealReg
RealRegSingle ([Int] -> [RealReg]) -> [Int] -> [RealReg]
forall a b. (a -> b) -> a -> b
$ Int -> Word32 -> Word32 -> Int -> [Int]
forall a. (Num a, Bits a) => Int -> a -> a -> Int -> [Int]
go Int
1 Word32
f Word32
1 Int
32
| RegClass
RcDouble <- RegClass
cls = (Int -> RealReg) -> [Int] -> [RealReg]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Int -> Int -> RealReg
RealRegPair Int
i (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) ([Int] -> [RealReg]) -> [Int] -> [RealReg]
forall a b. (a -> b) -> a -> b
$ Int -> Word32 -> Word32 -> Int -> [Int]
forall a. (Num a, Bits a) => Int -> a -> a -> Int -> [Int]
go Int
2 Word32
d Word32
1 Int
32
| Bool
otherwise = String -> SDoc -> [RealReg]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"RegAllocLinear.getFreeRegs: Bad register class " (RegClass -> SDoc
forall a. Outputable a => a -> SDoc
ppr RegClass
cls)
where
go :: Int -> a -> a -> Int -> [Int]
go Int
_ a
_ a
0 Int
_
= []
go Int
step a
bitmap a
mask Int
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
= Int
ix Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Int -> a -> a -> Int -> [Int]
go Int
step a
bitmap (a
mask a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
step) (Int -> [Int]) -> Int -> [Int]
forall a b. (a -> b) -> a -> b
$! Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step)
| Bool
otherwise
= Int -> a -> a -> Int -> [Int]
go Int
step a
bitmap (a
mask a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
step) (Int -> [Int]) -> Int -> [Int]
forall a b. (a -> b) -> a -> b
$! Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step
allocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
allocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
allocateReg Platform
platform
reg :: RealReg
reg@(RealRegSingle Int
r)
(FreeRegs Word32
g Word32
f Word32
d)
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Platform -> Int -> Bool
freeReg Platform
platform Int
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)
| Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
31
= let mask :: Word32
mask = Word32 -> Word32
forall a. Bits a => a -> a
complement (Int -> Word32
bitMask Int
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
| Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
32, Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
63
= let mask :: Word32
mask = Word32 -> Word32
forall a. Bits a => a -> a
complement (Int -> Word32
bitMask (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32))
maskLow :: Word32
maskLow = if Int
r Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Word32 -> Word32
forall a. Bits a => a -> a
complement (Int -> Word32
bitMask (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32))
else Word32 -> Word32
forall a. Bits a => a -> a
complement (Int -> Word32
bitMask (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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 Int
r1 Int
r2)
(FreeRegs Word32
g Word32
f Word32
d)
| Int
r1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
32, Int
r1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
63, Int
r1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
, Int
r2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
32, Int
r2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
63
= let mask1 :: Word32
mask1 = Word32 -> Word32
forall a. Bits a => a -> a
complement (Int -> Word32
bitMask (Int
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32))
mask2 :: Word32
mask2 = Word32 -> Word32
forall a. Bits a => a -> a
complement (Int -> Word32
bitMask (Int
r2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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)
releaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
releaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
releaseReg Platform
platform
reg :: RealReg
reg@(RealRegSingle Int
r)
regs :: FreeRegs
regs@(FreeRegs Word32
g Word32
f Word32
d)
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Platform -> Int -> Bool
freeReg Platform
platform Int
r
= FreeRegs
regs
| Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
31
= let mask :: Word32
mask = Int -> Word32
bitMask Int
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
| Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
32, Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
63
= let mask :: Word32
mask = Int -> Word32
bitMask (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32)
maskLow :: Word32
maskLow = if Int
r Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Int -> Word32
bitMask (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32)
else Int -> Word32
bitMask (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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 Int
r1 Int
r2)
(FreeRegs Word32
g Word32
f Word32
d)
| Int
r1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
32, Int
r1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
63, Int
r1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
, Int
r2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
32, Int
r2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
63
= let mask1 :: Word32
mask1 = Int -> Word32
bitMask (Int
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32)
mask2 :: Word32
mask2 = Int -> Word32
bitMask (Int
r2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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 :: Int -> Word32
bitMask Int
n = Word32
1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
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"