module GHC.CmmToAsm.Reg.Linear.StackMap (
StackSlot,
StackMap(..),
emptyStackMap,
getStackSlotFor,
getStackUse
)
where
import GHC.Prelude
import GHC.Types.Unique.FM
import GHC.Types.Unique
import GHC.CmmToAsm.Format
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 UniqFM Unique Int
forall {k} (key :: k) elt. UniqFM key elt
emptyUFM
getStackSlotFor :: StackMap -> Format -> Unique -> (StackMap, Int)
getStackSlotFor :: StackMap -> Format -> Unique -> (StackMap, Int)
getStackSlotFor fs :: StackMap
fs@(StackMap Int
_ UniqFM Unique Int
reserved) Format
_fmt Unique
regUnique
| Just Int
slot <- UniqFM Unique Int -> Unique -> Maybe Int
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM Unique Int
reserved Unique
regUnique = (StackMap
fs, Int
slot)
getStackSlotFor (StackMap Int
freeSlot UniqFM Unique Int
reserved) Format
fmt Unique
regUnique =
let
nbSlots :: Int
nbSlots = (Format -> Int
formatInBytes Format
fmt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
in
(Int -> UniqFM Unique Int -> StackMap
StackMap (Int
freeSlotInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
nbSlots) (UniqFM Unique Int -> Unique -> Int -> UniqFM Unique Int
forall key elt.
Uniquable key =>
UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM UniqFM Unique Int
reserved Unique
regUnique Int
freeSlot), Int
freeSlot)
getStackUse :: StackMap -> Int
getStackUse :: StackMap -> Int
getStackUse (StackMap Int
freeSlot UniqFM Unique Int
_) = Int
freeSlot