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

-- | Native code generator for RiscV64 architectures
module GHC.CmmToAsm.RV64 (ncgRV64) where

import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.Monad
import GHC.CmmToAsm.RV64.CodeGen qualified as RV64
import GHC.CmmToAsm.RV64.Instr qualified as RV64
import GHC.CmmToAsm.RV64.Ppr qualified as RV64
import GHC.CmmToAsm.RV64.RegInfo qualified as RV64
import GHC.CmmToAsm.RV64.Regs qualified as RV64
import GHC.CmmToAsm.Types
import GHC.Prelude
import GHC.Utils.Outputable (ftext)

ncgRV64 :: NCGConfig -> NcgImpl RawCmmStatics RV64.Instr RV64.JumpDest
ncgRV64 :: NCGConfig -> NcgImpl RawCmmStatics Instr JumpDest
ncgRV64 NCGConfig
config =
  NcgImpl
    { ncgConfig :: NCGConfig
ncgConfig = NCGConfig
config,
      cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl RawCmmStatics Instr]
cmmTopCodeGen = RawCmmDecl -> NatM [NatCmmDecl RawCmmStatics Instr]
RV64.cmmTopCodeGen,
      generateJumpTableForInstr :: Instr -> Maybe (NatCmmDecl RawCmmStatics Instr)
generateJumpTableForInstr = NCGConfig -> Instr -> Maybe (NatCmmDecl RawCmmStatics Instr)
RV64.generateJumpTableForInstr NCGConfig
config,
      getJumpDestBlockId :: JumpDest -> Maybe BlockId
getJumpDestBlockId = JumpDest -> Maybe BlockId
RV64.getJumpDestBlockId,
      canShortcut :: Instr -> Maybe JumpDest
canShortcut = Instr -> Maybe JumpDest
RV64.canShortcut,
      shortcutStatics :: (BlockId -> Maybe JumpDest) -> RawCmmStatics -> RawCmmStatics
shortcutStatics = (BlockId -> Maybe JumpDest) -> RawCmmStatics -> RawCmmStatics
RV64.shortcutStatics,
      shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
shortcutJump = (BlockId -> Maybe JumpDest) -> Instr -> Instr
RV64.shortcutJump,
      pprNatCmmDeclS :: NatCmmDecl RawCmmStatics Instr -> SDoc
pprNatCmmDeclS = NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc
forall doc.
IsDoc doc =>
NCGConfig -> NatCmmDecl RawCmmStatics Instr -> doc
RV64.pprNatCmmDecl NCGConfig
config,
      pprNatCmmDeclH :: NatCmmDecl RawCmmStatics Instr -> HDoc
pprNatCmmDeclH = NCGConfig -> NatCmmDecl RawCmmStatics Instr -> HDoc
forall doc.
IsDoc doc =>
NCGConfig -> NatCmmDecl RawCmmStatics Instr -> doc
RV64.pprNatCmmDecl NCGConfig
config,
      maxSpillSlots :: Int
maxSpillSlots = NCGConfig -> Int
RV64.maxSpillSlots NCGConfig
config,
      allocatableRegs :: [RealReg]
allocatableRegs = Platform -> [RealReg]
RV64.allocatableRegs Platform
platform,
      ncgAllocMoreStack :: Int
-> NatCmmDecl RawCmmStatics Instr
-> UniqSM (NatCmmDecl RawCmmStatics Instr, [(BlockId, BlockId)])
ncgAllocMoreStack = Platform
-> Int
-> NatCmmDecl RawCmmStatics Instr
-> UniqSM (NatCmmDecl RawCmmStatics Instr, [(BlockId, BlockId)])
forall statics.
Platform
-> Int
-> NatCmmDecl statics Instr
-> UniqSM (NatCmmDecl statics Instr, [(BlockId, BlockId)])
RV64.allocMoreStack Platform
platform,
      ncgMakeFarBranches :: Platform
-> LabelMap RawCmmStatics
-> [NatBasicBlock Instr]
-> UniqSM [NatBasicBlock Instr]
ncgMakeFarBranches = Platform
-> LabelMap RawCmmStatics
-> [NatBasicBlock Instr]
-> UniqSM [NatBasicBlock Instr]
RV64.makeFarBranches,
      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
    }
  where
    platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config

-- | `Instruction` instance for RV64
instance Instruction RV64.Instr where
  regUsageOfInstr :: Platform -> Instr -> RegUsage
regUsageOfInstr = Platform -> Instr -> RegUsage
RV64.regUsageOfInstr
  patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr = Instr -> (Reg -> Reg) -> Instr
RV64.patchRegsOfInstr
  isJumpishInstr :: Instr -> Bool
isJumpishInstr = Instr -> Bool
RV64.isJumpishInstr
  canFallthroughTo :: Instr -> BlockId -> Bool
canFallthroughTo = Instr -> BlockId -> Bool
RV64.canFallthroughTo
  jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr = Instr -> [BlockId]
RV64.jumpDestsOfInstr
  patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
patchJumpInstr = Instr -> (BlockId -> BlockId) -> Instr
RV64.patchJumpInstr
  mkSpillInstr :: NCGConfig -> Reg -> Int -> Int -> [Instr]
mkSpillInstr = HasCallStack => NCGConfig -> Reg -> Int -> Int -> [Instr]
NCGConfig -> Reg -> Int -> Int -> [Instr]
RV64.mkSpillInstr
  mkLoadInstr :: NCGConfig -> Reg -> Int -> Int -> [Instr]
mkLoadInstr = NCGConfig -> Reg -> Int -> Int -> [Instr]
RV64.mkLoadInstr
  takeDeltaInstr :: Instr -> Maybe Int
takeDeltaInstr = Instr -> Maybe Int
RV64.takeDeltaInstr
  isMetaInstr :: Instr -> Bool
isMetaInstr = Instr -> Bool
RV64.isMetaInstr
  mkRegRegMoveInstr :: Platform -> Reg -> Reg -> Instr
mkRegRegMoveInstr Platform
_ = Reg -> Reg -> Instr
RV64.mkRegRegMoveInstr
  takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg)
takeRegRegMoveInstr = Instr -> Maybe (Reg, Reg)
RV64.takeRegRegMoveInstr
  mkJumpInstr :: BlockId -> [Instr]
mkJumpInstr = BlockId -> [Instr]
RV64.mkJumpInstr
  mkStackAllocInstr :: Platform -> Int -> [Instr]
mkStackAllocInstr = Platform -> Int -> [Instr]
RV64.mkStackAllocInstr
  mkStackDeallocInstr :: Platform -> Int -> [Instr]
mkStackDeallocInstr = Platform -> Int -> [Instr]
RV64.mkStackDeallocInstr
  mkComment :: FastString -> [Instr]
mkComment = Instr -> [Instr]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Instr -> [Instr])
-> (FastString -> Instr) -> FastString -> [Instr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> Instr
RV64.COMMENT (SDoc -> Instr) -> (FastString -> SDoc) -> FastString -> Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext
  pprInstr :: Platform -> Instr -> SDoc
pprInstr = Platform -> Instr -> SDoc
forall doc. IsDoc doc => Platform -> Instr -> doc
RV64.pprInstr