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

-- | Native code generator for LoongArch64 architectures
module GHC.CmmToAsm.LA64 ( ncgLA64 ) where

import GHC.Prelude

import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.Monad
import GHC.CmmToAsm.Types
import GHC.Utils.Outputable (ftext)

import qualified GHC.CmmToAsm.LA64.CodeGen  as LA64
import qualified GHC.CmmToAsm.LA64.Instr    as LA64
import qualified GHC.CmmToAsm.LA64.Ppr      as LA64
import qualified GHC.CmmToAsm.LA64.RegInfo  as LA64
import qualified GHC.CmmToAsm.LA64.Regs     as LA64

ncgLA64 :: NCGConfig -> NcgImpl RawCmmStatics LA64.Instr LA64.JumpDest
ncgLA64 :: NCGConfig -> NcgImpl RawCmmStatics Instr JumpDest
ncgLA64 NCGConfig
config =
  NcgImpl
    { ncgConfig :: NCGConfig
ncgConfig                 = NCGConfig
config,
      cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl RawCmmStatics Instr]
cmmTopCodeGen             = RawCmmDecl -> NatM [NatCmmDecl RawCmmStatics Instr]
LA64.cmmTopCodeGen,
      generateJumpTableForInstr :: Instr -> Maybe (NatCmmDecl RawCmmStatics Instr)
generateJumpTableForInstr = NCGConfig -> Instr -> Maybe (NatCmmDecl RawCmmStatics Instr)
LA64.generateJumpTableForInstr NCGConfig
config,
      getJumpDestBlockId :: JumpDest -> Maybe BlockId
getJumpDestBlockId        = JumpDest -> Maybe BlockId
LA64.getJumpDestBlockId,
      canShortcut :: Instr -> Maybe JumpDest
canShortcut               = Instr -> Maybe JumpDest
LA64.canShortcut,
      shortcutStatics :: (BlockId -> Maybe JumpDest) -> RawCmmStatics -> RawCmmStatics
shortcutStatics           = (BlockId -> Maybe JumpDest) -> RawCmmStatics -> RawCmmStatics
LA64.shortcutStatics,
      shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
shortcutJump              = (BlockId -> Maybe JumpDest) -> Instr -> Instr
LA64.shortcutJump,
      pprNatCmmDeclS :: NatCmmDecl RawCmmStatics Instr -> SDoc
pprNatCmmDeclS            = NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc
forall doc.
IsDoc doc =>
NCGConfig -> NatCmmDecl RawCmmStatics Instr -> doc
LA64.pprNatCmmDecl NCGConfig
config,
      pprNatCmmDeclH :: NatCmmDecl RawCmmStatics Instr -> HDoc
pprNatCmmDeclH            = NCGConfig -> NatCmmDecl RawCmmStatics Instr -> HDoc
forall doc.
IsDoc doc =>
NCGConfig -> NatCmmDecl RawCmmStatics Instr -> doc
LA64.pprNatCmmDecl NCGConfig
config,
      maxSpillSlots :: Int
maxSpillSlots             = NCGConfig -> Int
LA64.maxSpillSlots NCGConfig
config,
      allocatableRegs :: [RealReg]
allocatableRegs           = Platform -> [RealReg]
LA64.allocatableRegs Platform
platform,
      ncgAllocMoreStack :: Int
-> NatCmmDecl RawCmmStatics Instr
-> UniqDSM (NatCmmDecl RawCmmStatics Instr, [(BlockId, BlockId)])
ncgAllocMoreStack         = Platform
-> Int
-> NatCmmDecl RawCmmStatics Instr
-> UniqDSM (NatCmmDecl RawCmmStatics Instr, [(BlockId, BlockId)])
forall statics.
Platform
-> Int
-> NatCmmDecl statics Instr
-> UniqDSM (NatCmmDecl statics Instr, [(BlockId, BlockId)])
LA64.allocMoreStack Platform
platform,
      ncgMakeFarBranches :: Platform
-> LabelMap RawCmmStatics
-> [NatBasicBlock Instr]
-> UniqDSM [NatBasicBlock Instr]
ncgMakeFarBranches        = \Platform
_p LabelMap RawCmmStatics
_i [NatBasicBlock Instr]
bs -> [NatBasicBlock Instr] -> UniqDSM [NatBasicBlock Instr]
forall a. a -> UniqDSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [NatBasicBlock Instr]
bs,
      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 LA64
instance Instruction LA64.Instr where
  regUsageOfInstr :: Platform -> Instr -> RegUsage
regUsageOfInstr       = Platform -> Instr -> RegUsage
LA64.regUsageOfInstr
  patchRegsOfInstr :: HasDebugCallStack => Platform -> Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr Platform
_    = Instr -> (Reg -> Reg) -> Instr
LA64.patchRegsOfInstr
  isJumpishInstr :: Instr -> Bool
isJumpishInstr        = Instr -> Bool
LA64.isJumpishInstr
  canFallthroughTo :: Instr -> BlockId -> Bool
canFallthroughTo      = Instr -> BlockId -> Bool
LA64.canFallthroughTo
  jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr      = Instr -> [BlockId]
LA64.jumpDestsOfInstr
  patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
patchJumpInstr        = Instr -> (BlockId -> BlockId) -> Instr
LA64.patchJumpInstr
  mkSpillInstr :: HasDebugCallStack =>
NCGConfig -> RegWithFormat -> Int -> Int -> [Instr]
mkSpillInstr          = HasCallStack => NCGConfig -> RegWithFormat -> Int -> Int -> [Instr]
NCGConfig -> RegWithFormat -> Int -> Int -> [Instr]
LA64.mkSpillInstr
  mkLoadInstr :: HasDebugCallStack =>
NCGConfig -> RegWithFormat -> Int -> Int -> [Instr]
mkLoadInstr           = NCGConfig -> RegWithFormat -> Int -> Int -> [Instr]
LA64.mkLoadInstr
  takeDeltaInstr :: Instr -> Maybe Int
takeDeltaInstr        = Instr -> Maybe Int
LA64.takeDeltaInstr
  isMetaInstr :: Instr -> Bool
isMetaInstr           = Instr -> Bool
LA64.isMetaInstr
  mkRegRegMoveInstr :: HasDebugCallStack => NCGConfig -> Format -> Reg -> Reg -> Instr
mkRegRegMoveInstr NCGConfig
_ Format
_ = Reg -> Reg -> Instr
LA64.mkRegRegMoveInstr
  takeRegRegMoveInstr :: Platform -> Instr -> Maybe (Reg, Reg)
takeRegRegMoveInstr Platform
_ = Instr -> Maybe (Reg, Reg)
LA64.takeRegRegMoveInstr
  mkJumpInstr :: BlockId -> [Instr]
mkJumpInstr           = BlockId -> [Instr]
LA64.mkJumpInstr
  mkStackAllocInstr :: Platform -> Int -> [Instr]
mkStackAllocInstr     = Platform -> Int -> [Instr]
LA64.mkStackAllocInstr
  mkStackDeallocInstr :: Platform -> Int -> [Instr]
mkStackDeallocInstr   = Platform -> Int -> [Instr]
LA64.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
LA64.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
LA64.pprInstr