-- | Put common type definitions here to break recursive module dependencies.

module GHC.CmmToAsm.Reg.Linear.Base (
        BlockAssignment,

        Loc(..),
        regsOfLoc,

        -- for stats
        SpillReason(..),
        RegAllocStats(..),

        -- the allocator monad
        RA_State(..),
)

where

import GHC.Prelude

import GHC.CmmToAsm.Reg.Linear.StackMap
import GHC.CmmToAsm.Reg.Liveness
import GHC.CmmToAsm.Config
import GHC.Platform.Reg

import GHC.Utils.Outputable
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Types.Unique.Supply
import GHC.Cmm.BlockId

data ReadingOrWriting = Reading | Writing deriving (ReadingOrWriting -> ReadingOrWriting -> Bool
(ReadingOrWriting -> ReadingOrWriting -> Bool)
-> (ReadingOrWriting -> ReadingOrWriting -> Bool)
-> Eq ReadingOrWriting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadingOrWriting -> ReadingOrWriting -> Bool
$c/= :: ReadingOrWriting -> ReadingOrWriting -> Bool
== :: ReadingOrWriting -> ReadingOrWriting -> Bool
$c== :: ReadingOrWriting -> ReadingOrWriting -> Bool
Eq,Eq ReadingOrWriting
Eq ReadingOrWriting
-> (ReadingOrWriting -> ReadingOrWriting -> Ordering)
-> (ReadingOrWriting -> ReadingOrWriting -> Bool)
-> (ReadingOrWriting -> ReadingOrWriting -> Bool)
-> (ReadingOrWriting -> ReadingOrWriting -> Bool)
-> (ReadingOrWriting -> ReadingOrWriting -> Bool)
-> (ReadingOrWriting -> ReadingOrWriting -> ReadingOrWriting)
-> (ReadingOrWriting -> ReadingOrWriting -> ReadingOrWriting)
-> Ord ReadingOrWriting
ReadingOrWriting -> ReadingOrWriting -> Bool
ReadingOrWriting -> ReadingOrWriting -> Ordering
ReadingOrWriting -> ReadingOrWriting -> ReadingOrWriting
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReadingOrWriting -> ReadingOrWriting -> ReadingOrWriting
$cmin :: ReadingOrWriting -> ReadingOrWriting -> ReadingOrWriting
max :: ReadingOrWriting -> ReadingOrWriting -> ReadingOrWriting
$cmax :: ReadingOrWriting -> ReadingOrWriting -> ReadingOrWriting
>= :: ReadingOrWriting -> ReadingOrWriting -> Bool
$c>= :: ReadingOrWriting -> ReadingOrWriting -> Bool
> :: ReadingOrWriting -> ReadingOrWriting -> Bool
$c> :: ReadingOrWriting -> ReadingOrWriting -> Bool
<= :: ReadingOrWriting -> ReadingOrWriting -> Bool
$c<= :: ReadingOrWriting -> ReadingOrWriting -> Bool
< :: ReadingOrWriting -> ReadingOrWriting -> Bool
$c< :: ReadingOrWriting -> ReadingOrWriting -> Bool
compare :: ReadingOrWriting -> ReadingOrWriting -> Ordering
$ccompare :: ReadingOrWriting -> ReadingOrWriting -> Ordering
Instance of class: Eq of the constraint type Eq ReadingOrWriting
Instance of class: Ord of the constraint type Ord ReadingOrWriting
Instance of class: Eq of the constraint type Eq ReadingOrWriting
Ord)

-- | Used to store the register assignment on entry to a basic block.
--      We use this to handle join points, where multiple branch instructions
--      target a particular label. We have to insert fixup code to make
--      the register assignments from the different sources match up.
--
type BlockAssignment freeRegs
        = BlockMap (freeRegs, RegMap Loc)


-- | Where a vreg is currently stored
--      A temporary can be marked as living in both a register and memory
--      (InBoth), for example if it was recently loaded from a spill location.
--      This makes it cheap to spill (no save instruction required), but we
--      have to be careful to turn this into InReg if the value in the
--      register is changed.

--      This is also useful when a temporary is about to be clobbered.  We
--      save it in a spill location, but mark it as InBoth because the current
--      instruction might still want to read it.
--
data Loc
        -- | vreg is in a register
        = InReg   !RealReg

        -- | vreg is held in a stack slot
        | InMem   {-# UNPACK #-}  !StackSlot


        -- | vreg is held in both a register and a stack slot
        | InBoth   !RealReg
                   {-# UNPACK #-} !StackSlot
        deriving (Loc -> Loc -> Bool
(Loc -> Loc -> Bool) -> (Loc -> Loc -> Bool) -> Eq Loc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Loc -> Loc -> Bool
$c/= :: Loc -> Loc -> Bool
== :: Loc -> Loc -> Bool
$c== :: Loc -> Loc -> Bool
External instance of the constraint type Eq StackSlot
External instance of the constraint type Eq StackSlot
External instance of the constraint type Eq RealReg
External instance of the constraint type Eq RealReg
Eq, StackSlot -> Loc -> ShowS
[Loc] -> ShowS
Loc -> String
(StackSlot -> Loc -> ShowS)
-> (Loc -> String) -> ([Loc] -> ShowS) -> Show Loc
forall a.
(StackSlot -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Loc] -> ShowS
$cshowList :: [Loc] -> ShowS
show :: Loc -> String
$cshow :: Loc -> String
showsPrec :: StackSlot -> Loc -> ShowS
$cshowsPrec :: StackSlot -> Loc -> ShowS
External instance of the constraint type Show StackSlot
External instance of the constraint type Show StackSlot
External instance of the constraint type Show RealReg
External instance of the constraint type Show RealReg
External instance of the constraint type Ord StackSlot
External instance of the constraint type Ord StackSlot
Show, Eq Loc
Eq Loc
-> (Loc -> Loc -> Ordering)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Loc)
-> (Loc -> Loc -> Loc)
-> Ord Loc
Loc -> Loc -> Bool
Loc -> Loc -> Ordering
Loc -> Loc -> Loc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Loc -> Loc -> Loc
$cmin :: Loc -> Loc -> Loc
max :: Loc -> Loc -> Loc
$cmax :: Loc -> Loc -> Loc
>= :: Loc -> Loc -> Bool
$c>= :: Loc -> Loc -> Bool
> :: Loc -> Loc -> Bool
$c> :: Loc -> Loc -> Bool
<= :: Loc -> Loc -> Bool
$c<= :: Loc -> Loc -> Bool
< :: Loc -> Loc -> Bool
$c< :: Loc -> Loc -> Bool
compare :: Loc -> Loc -> Ordering
$ccompare :: Loc -> Loc -> Ordering
External instance of the constraint type Ord StackSlot
External instance of the constraint type Ord RealReg
External instance of the constraint type Ord StackSlot
External instance of the constraint type Ord RealReg
External instance of the constraint type Ord RealReg
Instance of class: Eq of the constraint type Eq Loc
External instance of the constraint type Ord StackSlot
Instance of class: Ord of the constraint type Ord Loc
Instance of class: Eq of the constraint type Eq Loc
Ord)

instance Outputable Loc where
        ppr :: Loc -> SDoc
ppr Loc
l = String -> SDoc
text (Loc -> String
forall a. Show a => a -> String
Instance of class: Show of the constraint type Show Loc
show Loc
l)


-- | Get the reg numbers stored in this Loc.
regsOfLoc :: Loc -> [RealReg]
regsOfLoc :: Loc -> [RealReg]
regsOfLoc (InReg RealReg
r)    = [RealReg
r]
regsOfLoc (InBoth RealReg
r StackSlot
_) = [RealReg
r]
regsOfLoc (InMem StackSlot
_)    = []


-- | Reasons why instructions might be inserted by the spiller.
--      Used when generating stats for -ddrop-asm-stats.
--
data SpillReason
        -- | vreg was spilled to a slot so we could use its
        --      current hreg for another vreg
        = SpillAlloc    !Unique

        -- | vreg was moved because its hreg was clobbered
        | SpillClobber  !Unique

        -- | vreg was loaded from a spill slot
        | SpillLoad     !Unique

        -- | reg-reg move inserted during join to targets
        | SpillJoinRR   !Unique

        -- | reg-mem move inserted during join to targets
        | SpillJoinRM   !Unique


-- | Used to carry interesting stats out of the register allocator.
data RegAllocStats
        = RegAllocStats
        { RegAllocStats -> UniqFM [StackSlot]
ra_spillInstrs        :: UniqFM [Int]
        , RegAllocStats -> [(BlockId, BlockId, BlockId)]
ra_fixupList     :: [(BlockId,BlockId,BlockId)]
        -- ^ (from,fixup,to) : We inserted fixup code between from and to
        }


-- | The register allocator state
data RA_State freeRegs
        = RA_State

        {
        -- | the current mapping from basic blocks to
        --      the register assignments at the beginning of that block.
          RA_State freeRegs -> BlockAssignment freeRegs
ra_blockassig :: BlockAssignment freeRegs

        -- | free machine registers
        , RA_State freeRegs -> freeRegs
ra_freeregs   :: !freeRegs

        -- | assignment of temps to locations
        , RA_State freeRegs -> RegMap Loc
ra_assig      :: RegMap Loc

        -- | current stack delta
        , RA_State freeRegs -> StackSlot
ra_delta      :: Int

        -- | free stack slots for spilling
        , RA_State freeRegs -> StackMap
ra_stack      :: StackMap

        -- | unique supply for generating names for join point fixup blocks.
        , RA_State freeRegs -> UniqSupply
ra_us         :: UniqSupply

        -- | Record why things were spilled, for -ddrop-asm-stats.
        --      Just keep a list here instead of a map of regs -> reasons.
        --      We don't want to slow down the allocator if we're not going to emit the stats.
        , RA_State freeRegs -> [SpillReason]
ra_spills     :: [SpillReason]

        -- | Native code generator configuration
        , RA_State freeRegs -> NCGConfig
ra_config     :: !NCGConfig

        -- | (from,fixup,to) : We inserted fixup code between from and to
        , RA_State freeRegs -> [(BlockId, BlockId, BlockId)]
ra_fixups     :: [(BlockId,BlockId,BlockId)]

        }