module Instruction (
        RegUsage(..),
        noUsage,
        GenBasicBlock(..), blockId,
        ListGraph(..),
        NatCmm,
        NatCmmDecl,
        NatBasicBlock,
        topInfoTable,
        entryBlocks,
        Instruction(..)
)

where

import GhcPrelude

import Reg

import BlockId
import Hoopl.Collections
import Hoopl.Label
import DynFlags
import Cmm hiding (topInfoTable)
import Platform

-- | Holds a list of source and destination registers used by a
--      particular instruction.
--
--   Machine registers that are pre-allocated to stgRegs are filtered
--      out, because they are uninteresting from a register allocation
--      standpoint.  (We wouldn't want them to end up on the free list!)
--
--   As far as we are concerned, the fixed registers simply don't exist
--      (for allocation purposes, anyway).
--
data RegUsage
        = RU [Reg] [Reg]

-- | No regs read or written to.
noUsage :: RegUsage
noUsage :: RegUsage
noUsage  = [Reg] -> [Reg] -> RegUsage
RU [] []

-- Our flavours of the Cmm types
-- Type synonyms for Cmm populated with native code
type NatCmm instr
        = GenCmmGroup
                CmmStatics
                (LabelMap CmmStatics)
                (ListGraph instr)

type NatCmmDecl statics instr
        = GenCmmDecl
                statics
                (LabelMap CmmStatics)
                (ListGraph instr)


type NatBasicBlock instr
        = GenBasicBlock instr


-- | Returns the info table associated with the CmmDecl's entry point,
-- if any.
topInfoTable :: GenCmmDecl a (LabelMap i) (ListGraph b) -> Maybe i
topInfoTable :: GenCmmDecl a (LabelMap i) (ListGraph b) -> Maybe i
topInfoTable (CmmProc infos :: LabelMap i
infos _ _ (ListGraph (b :: GenBasicBlock b
b:_)))
  = KeyOf LabelMap -> LabelMap i -> Maybe i
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup (GenBasicBlock b -> BlockId
forall i. GenBasicBlock i -> BlockId
blockId GenBasicBlock b
b) LabelMap i
infos
topInfoTable _
  = Maybe i
forall a. Maybe a
Nothing

-- | Return the list of BlockIds in a CmmDecl that are entry points
-- for this proc (i.e. they may be jumped to from outside this proc).
entryBlocks :: GenCmmDecl a (LabelMap i) (ListGraph b) -> [BlockId]
entryBlocks :: GenCmmDecl a (LabelMap i) (ListGraph b) -> [BlockId]
entryBlocks (CmmProc info :: LabelMap i
info _ _ (ListGraph code :: [GenBasicBlock b]
code)) = [BlockId]
entries
  where
        infos :: [KeyOf LabelMap]
infos = LabelMap i -> [KeyOf LabelMap]
forall (map :: * -> *) a. IsMap map => map a -> [KeyOf map]
mapKeys LabelMap i
info
        entries :: [BlockId]
entries = case [GenBasicBlock b]
code of
                    [] -> [BlockId]
infos
                    BasicBlock entry :: BlockId
entry _ : _ -- first block is the entry point
                       | BlockId
entry BlockId -> [BlockId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BlockId]
infos -> [BlockId]
infos
                       | Bool
otherwise          -> BlockId
entry BlockId -> [BlockId] -> [BlockId]
forall a. a -> [a] -> [a]
: [BlockId]
infos
entryBlocks _ = []

-- | Common things that we can do with instructions, on all architectures.
--      These are used by the shared parts of the native code generator,
--      specifically the register allocators.
--
class   Instruction instr where

        -- | Get the registers that are being used by this instruction.
        --      regUsage doesn't need to do any trickery for jumps and such.
        --      Just state precisely the regs read and written by that insn.
        --      The consequences of control flow transfers, as far as register
        --      allocation goes, are taken care of by the register allocator.
        --
        regUsageOfInstr
                :: Platform
                -> instr
                -> RegUsage


        -- | Apply a given mapping to all the register references in this
        --      instruction.
        patchRegsOfInstr
                :: instr
                -> (Reg -> Reg)
                -> instr


        -- | Checks whether this instruction is a jump/branch instruction.
        --      One that can change the flow of control in a way that the
        --      register allocator needs to worry about.
        isJumpishInstr
                :: instr -> Bool


        -- | Give the possible destinations of this jump instruction.
        --      Must be defined for all jumpish instructions.
        jumpDestsOfInstr
                :: instr -> [BlockId]


        -- | Change the destination of this jump instruction.
        --      Used in the linear allocator when adding fixup blocks for join
        --      points.
        patchJumpInstr
                :: instr
                -> (BlockId -> BlockId)
                -> instr


        -- | An instruction to spill a register into a spill slot.
        mkSpillInstr
                :: DynFlags
                -> Reg          -- ^ the reg to spill
                -> Int          -- ^ the current stack delta
                -> Int          -- ^ spill slot to use
                -> instr


        -- | An instruction to reload a register from a spill slot.
        mkLoadInstr
                :: DynFlags
                -> Reg          -- ^ the reg to reload.
                -> Int          -- ^ the current stack delta
                -> Int          -- ^ the spill slot to use
                -> instr

        -- | See if this instruction is telling us the current C stack delta
        takeDeltaInstr
                :: instr
                -> Maybe Int

        -- | Check whether this instruction is some meta thing inserted into
        --      the instruction stream for other purposes.
        --
        --      Not something that has to be treated as a real machine instruction
        --      and have its registers allocated.
        --
        --      eg, comments, delta, ldata, etc.
        isMetaInstr
                :: instr
                -> Bool



        -- | Copy the value in a register to another one.
        --      Must work for all register classes.
        mkRegRegMoveInstr
                :: Platform
                -> Reg          -- ^ source register
                -> Reg          -- ^ destination register
                -> instr

        -- | Take the source and destination from this reg -> reg move instruction
        --      or Nothing if it's not one
        takeRegRegMoveInstr
                :: instr
                -> Maybe (Reg, Reg)

        -- | Make an unconditional jump instruction.
        --      For architectures with branch delay slots, its ok to put
        --      a NOP after the jump. Don't fill the delay slot with an
        --      instruction that references regs or you'll confuse the
        --      linear allocator.
        mkJumpInstr
                :: BlockId
                -> [instr]


        -- Subtract an amount from the C stack pointer
        mkStackAllocInstr
                :: Platform
                -> Int
                -> [instr]

        -- Add an amount to the C stack pointer
        mkStackDeallocInstr
                :: Platform
                -> Int
                -> [instr]