-- | One ounce of sanity checking is worth 10000000000000000 ounces
-- of staring blindly at assembly code trying to find the problem..
module SPARC.CodeGen.Sanity (
        checkBlock
)

where

import GhcPrelude

import SPARC.Instr
import SPARC.Ppr        () -- For Outputable instances
import Instruction

import Cmm

import Outputable


-- | Enforce intra-block invariants.
--
checkBlock :: CmmBlock
           -> NatBasicBlock Instr
           -> NatBasicBlock Instr

checkBlock :: CmmBlock -> NatBasicBlock Instr -> NatBasicBlock Instr
checkBlock CmmBlock
cmm block :: NatBasicBlock Instr
block@(BasicBlock BlockId
_ [Instr]
instrs)
        | [Instr] -> Bool
checkBlockInstrs [Instr]
instrs
        = NatBasicBlock Instr
block

        | Bool
otherwise
        = String -> SDoc -> NatBasicBlock Instr
forall a. HasCallStack => String -> SDoc -> a
pprPanic
                (String
"SPARC.CodeGen: bad block\n")
                ( [SDoc] -> SDoc
vcat  [ String -> SDoc
text String
" -- cmm -----------------\n"
                        , CmmBlock -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmBlock
cmm
                        , String -> SDoc
text String
" -- native code ---------\n"
                        , NatBasicBlock Instr -> SDoc
forall a. Outputable a => a -> SDoc
ppr NatBasicBlock Instr
block ])


checkBlockInstrs :: [Instr] -> Bool
checkBlockInstrs :: [Instr] -> Bool
checkBlockInstrs [Instr]
ii

        -- An unconditional jumps end the block.
        --      There must be an unconditional jump in the block, otherwise
        --      the register liveness determinator will get the liveness
        --      information wrong.
        --
        --      If the block ends with a cmm call that never returns
        --      then there can be unreachable instructions after the jump,
        --      but we don't mind here.
        --
        | Instr
instr : Instr
NOP : [Instr]
_       <- [Instr]
ii
        , Instr -> Bool
isUnconditionalJump Instr
instr
        = Bool
True

        -- All jumps must have a NOP in their branch delay slot.
        --      The liveness determinator and register allocators aren't smart
        --      enough to handle branch delay slots.
        --
        | Instr
instr : Instr
NOP : [Instr]
is      <- [Instr]
ii
        , Instr -> Bool
forall instr. Instruction instr => instr -> Bool
isJumpishInstr Instr
instr
        = [Instr] -> Bool
checkBlockInstrs [Instr]
is

        -- keep checking
        | Instr
_:Instr
i2:[Instr]
is               <- [Instr]
ii
        = [Instr] -> Bool
checkBlockInstrs (Instr
i2Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
:[Instr]
is)

        -- this block is no good
        | Bool
otherwise
        = Bool
False