blob: 44eea342a4dfc9cd36bdc9c07c75bc86172dc158 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | Free regs map for x86_64
module GHC.CmmToAsm.Reg.Linear.X86_64 where
import GHC.Prelude
import GHC.CmmToAsm.X86.Regs
import GHC.Platform.Reg.Class
import GHC.Platform.Reg
import GHC.Utils.Panic
import GHC.Platform
import GHC.Utils.Outputable
import Data.Word
import Data.Bits
newtype FreeRegs = FreeRegs Word64
deriving (Show,Outputable)
noFreeRegs :: FreeRegs
noFreeRegs = FreeRegs 0
releaseReg :: RealReg -> FreeRegs -> FreeRegs
releaseReg (RealRegSingle n) (FreeRegs f)
= FreeRegs (f .|. (1 `shiftL` n))
releaseReg _ _
= panic "RegAlloc.Linear.X86_64.FreeRegs.releaseReg: no reg"
initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform
= foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)
getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
getFreeRegs platform cls (FreeRegs f) = go f 0
where go 0 _ = []
go n m
| n .&. 1 /= 0 && classOfRealReg platform (RealRegSingle m) == cls
= RealRegSingle m : (go (n `shiftR` 1) $! (m+1))
| otherwise
= go (n `shiftR` 1) $! (m+1)
-- ToDo: there's no point looking through all the integer registers
-- in order to find a floating-point one.
allocateReg :: RealReg -> FreeRegs -> FreeRegs
allocateReg (RealRegSingle r) (FreeRegs f)
= FreeRegs (f .&. complement (1 `shiftL` r))
allocateReg _ _
= panic "RegAlloc.Linear.X86_64.FreeRegs.allocateReg: no reg"
|
