module GHC.CmmToAsm.Reg.Linear.StackMap (
StackSlot,
StackMap(..),
emptyStackMap,
getStackSlotFor,
getStackUse
)
where
import GHC.Prelude
import GHC.Types.Unique.FM
import GHC.Types.Unique
type StackSlot = Int
data StackMap
= StackMap
{
StackMap -> Int
stackMapNextFreeSlot :: !Int
, StackMap -> UniqFM Unique Int
stackMapAssignment :: UniqFM Unique StackSlot }
emptyStackMap :: StackMap
emptyStackMap :: StackMap
emptyStackMap = Int -> UniqFM Unique Int -> StackMap
StackMap Int
0 forall key elt. UniqFM key elt
emptyUFM
getStackSlotFor :: StackMap -> Unique -> (StackMap, Int)
getStackSlotFor :: StackMap -> Unique -> (StackMap, Int)
getStackSlotFor fs :: StackMap
fs@(StackMap Int
_ UniqFM Unique Int
reserved) Unique
reg
| Just Int
slot <- forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM Unique Int
reserved Unique
reg = (StackMap
fs, Int
slot)
getStackSlotFor (StackMap Int
freeSlot UniqFM Unique Int
reserved) Unique
reg =
(Int -> UniqFM Unique Int -> StackMap
StackMap (Int
freeSlotforall a. Num a => a -> a -> a
+Int
1) (forall key elt.
Uniquable key =>
UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM UniqFM Unique Int
reserved Unique
reg Int
freeSlot), Int
freeSlot)
getStackUse :: StackMap -> Int
getStackUse :: StackMap -> Int
getStackUse (StackMap Int
freeSlot UniqFM Unique Int
_) = Int
freeSlot