{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Native code generator for SPARC architectures
module GHC.CmmToAsm.SPARC
   ( ncgSPARC
   )
where

import GHC.Prelude
import GHC.Utils.Panic

import GHC.CmmToAsm.Monad
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Types
import GHC.CmmToAsm.Instr

import qualified GHC.CmmToAsm.SPARC.Instr          as SPARC
import qualified GHC.CmmToAsm.SPARC.Ppr            as SPARC
import qualified GHC.CmmToAsm.SPARC.CodeGen        as SPARC
import qualified GHC.CmmToAsm.SPARC.CodeGen.Expand as SPARC
import qualified GHC.CmmToAsm.SPARC.Regs           as SPARC
import qualified GHC.CmmToAsm.SPARC.ShortcutJump   as SPARC


ncgSPARC :: NCGConfig -> NcgImpl RawCmmStatics SPARC.Instr SPARC.JumpDest
ncgSPARC :: NCGConfig -> NcgImpl RawCmmStatics Instr JumpDest
ncgSPARC NCGConfig
config = NcgImpl
   { ncgConfig :: NCGConfig
ncgConfig                 = NCGConfig
config
   , cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl RawCmmStatics Instr]
cmmTopCodeGen             = RawCmmDecl -> NatM [NatCmmDecl RawCmmStatics Instr]
SPARC.cmmTopCodeGen
   , generateJumpTableForInstr :: Instr -> Maybe (NatCmmDecl RawCmmStatics Instr)
generateJumpTableForInstr = Platform -> Instr -> Maybe (NatCmmDecl RawCmmStatics Instr)
SPARC.generateJumpTableForInstr Platform
platform
   , getJumpDestBlockId :: JumpDest -> Maybe BlockId
getJumpDestBlockId        = JumpDest -> Maybe BlockId
SPARC.getJumpDestBlockId
   , canShortcut :: Instr -> Maybe JumpDest
canShortcut               = Instr -> Maybe JumpDest
SPARC.canShortcut
   , shortcutStatics :: (BlockId -> Maybe JumpDest) -> RawCmmStatics -> RawCmmStatics
shortcutStatics           = (BlockId -> Maybe JumpDest) -> RawCmmStatics -> RawCmmStatics
SPARC.shortcutStatics
   , shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
shortcutJump              = (BlockId -> Maybe JumpDest) -> Instr -> Instr
SPARC.shortcutJump
   , pprNatCmmDecl :: NatCmmDecl RawCmmStatics Instr -> SDoc
pprNatCmmDecl             = NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc
SPARC.pprNatCmmDecl NCGConfig
config
   , maxSpillSlots :: Int
maxSpillSlots             = NCGConfig -> Int
SPARC.maxSpillSlots NCGConfig
config
   , allocatableRegs :: [RealReg]
allocatableRegs           = [RealReg]
SPARC.allocatableRegs
   , ncgExpandTop :: [NatCmmDecl RawCmmStatics Instr]
-> [NatCmmDecl RawCmmStatics Instr]
ncgExpandTop              = (NatCmmDecl RawCmmStatics Instr -> NatCmmDecl RawCmmStatics Instr)
-> [NatCmmDecl RawCmmStatics Instr]
-> [NatCmmDecl RawCmmStatics Instr]
forall a b. (a -> b) -> [a] -> [b]
map NatCmmDecl RawCmmStatics Instr -> NatCmmDecl RawCmmStatics Instr
SPARC.expandTop
   , ncgMakeFarBranches :: LabelMap RawCmmStatics
-> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
ncgMakeFarBranches        = ([NatBasicBlock Instr] -> [NatBasicBlock Instr])
-> LabelMap RawCmmStatics
-> [NatBasicBlock Instr]
-> [NatBasicBlock Instr]
forall a b. a -> b -> a
const [NatBasicBlock Instr] -> [NatBasicBlock Instr]
forall a. a -> a
id
   , extractUnwindPoints :: [Instr] -> [UnwindPoint]
extractUnwindPoints       = [UnwindPoint] -> [Instr] -> [UnwindPoint]
forall a b. a -> b -> a
const []
   , invertCondBranches :: Maybe CFG
-> LabelMap RawCmmStatics
-> [NatBasicBlock Instr]
-> [NatBasicBlock Instr]
invertCondBranches        = \Maybe CFG
_ LabelMap RawCmmStatics
_ -> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
forall a. a -> a
id
   -- Allocating more stack space for spilling isn't currently supported for the
   -- linear register allocator on SPARC, hence the panic below.
   , ncgAllocMoreStack :: Int
-> NatCmmDecl RawCmmStatics Instr
-> UniqSM (NatCmmDecl RawCmmStatics Instr, [(BlockId, BlockId)])
ncgAllocMoreStack         = Int
-> NatCmmDecl RawCmmStatics Instr
-> UniqSM (NatCmmDecl RawCmmStatics Instr, [(BlockId, BlockId)])
forall {a} {p} {a}. Show a => a -> p -> a
noAllocMoreStack
   }
    where
      platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config

      noAllocMoreStack :: a -> p -> a
noAllocMoreStack a
amount p
_
        = String -> a
forall a. String -> a
panic (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$   String
"Register allocator: out of stack slots (need " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
amount String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")\n"
              String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
"   If you are trying to compile SHA1.hs from the crypto library then this\n"
              String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
"   is a known limitation in the linear allocator.\n"
              String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
"\n"
              String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
"   Try enabling the graph colouring allocator with -fregs-graph instead."
              String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
"   You can still file a bug report if you like.\n"


-- | instance for sparc instruction set
instance Instruction SPARC.Instr where
   regUsageOfInstr :: Platform -> Instr -> RegUsage
regUsageOfInstr         = Platform -> Instr -> RegUsage
SPARC.regUsageOfInstr
   patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr        = Instr -> (Reg -> Reg) -> Instr
SPARC.patchRegsOfInstr
   isJumpishInstr :: Instr -> Bool
isJumpishInstr          = Instr -> Bool
SPARC.isJumpishInstr
   jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr        = Instr -> [BlockId]
SPARC.jumpDestsOfInstr
   patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
patchJumpInstr          = Instr -> (BlockId -> BlockId) -> Instr
SPARC.patchJumpInstr
   mkSpillInstr :: NCGConfig -> Reg -> Int -> Int -> [Instr]
mkSpillInstr            = NCGConfig -> Reg -> Int -> Int -> [Instr]
SPARC.mkSpillInstr
   mkLoadInstr :: NCGConfig -> Reg -> Int -> Int -> [Instr]
mkLoadInstr             = NCGConfig -> Reg -> Int -> Int -> [Instr]
SPARC.mkLoadInstr
   takeDeltaInstr :: Instr -> Maybe Int
takeDeltaInstr          = Instr -> Maybe Int
SPARC.takeDeltaInstr
   isMetaInstr :: Instr -> Bool
isMetaInstr             = Instr -> Bool
SPARC.isMetaInstr
   mkRegRegMoveInstr :: Platform -> Reg -> Reg -> Instr
mkRegRegMoveInstr       = Platform -> Reg -> Reg -> Instr
SPARC.mkRegRegMoveInstr
   takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg)
takeRegRegMoveInstr     = Instr -> Maybe (Reg, Reg)
SPARC.takeRegRegMoveInstr
   mkJumpInstr :: BlockId -> [Instr]
mkJumpInstr             = BlockId -> [Instr]
SPARC.mkJumpInstr
   pprInstr :: Platform -> Instr -> SDoc
pprInstr                = Platform -> Instr -> SDoc
SPARC.pprInstr
   mkComment :: SDoc -> [Instr]
mkComment               = [Instr] -> SDoc -> [Instr]
forall a b. a -> b -> a
const []
   mkStackAllocInstr :: Platform -> Int -> [Instr]
mkStackAllocInstr       = String -> Platform -> Int -> [Instr]
forall a. String -> a
panic String
"no sparc_mkStackAllocInstr"
   mkStackDeallocInstr :: Platform -> Int -> [Instr]
mkStackDeallocInstr     = String -> Platform -> Int -> [Instr]
forall a. String -> a
panic String
"no sparc_mkStackDeallocInstr"