    {-# language GADTs #-}
    {-# LANGUAGE OverloadedStrings #-}
    module GHC.CmmToAsm.AArch64.CodeGen (
          cmmTopCodeGen
        , generateJumpTableForInstr
        , makeFarBranches
    )

    where

    -- NCG stuff:
    import GHC.Prelude hiding (EQ)

    import Data.Word

    import GHC.Platform.Regs
    import GHC.CmmToAsm.AArch64.Instr
    import GHC.CmmToAsm.AArch64.Regs
    import GHC.CmmToAsm.AArch64.Cond

    import GHC.CmmToAsm.CPrim
    import GHC.Cmm.DebugBlock
    import GHC.CmmToAsm.Monad
       ( NatM, getNewRegNat
       , getPicBaseMaybeNat, getPlatform, getConfig
       , getDebugBlock, getFileId, getThisModuleNat
       )
    -- import GHC.CmmToAsm.Instr
    import GHC.CmmToAsm.PIC
    import GHC.CmmToAsm.Format
    import GHC.CmmToAsm.Config
    import GHC.CmmToAsm.Types
    import GHC.Platform.Reg
    import GHC.Platform

    -- Our intermediate code:
    import GHC.Cmm.BlockId
    import GHC.Cmm
    import GHC.Cmm.Utils
    import GHC.Cmm.Switch
    import GHC.Cmm.CLabel
    import GHC.Cmm.Dataflow.Block
    import GHC.Cmm.Dataflow.Label
    import GHC.Cmm.Dataflow.Graph
    import GHC.Types.Tickish ( GenTickish(..) )
    import GHC.Types.SrcLoc  ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
    import GHC.Types.Unique.Supply

    -- The rest:
    import GHC.Data.OrdList
    import GHC.Utils.Outputable

    import Control.Monad    ( mapAndUnzipM, foldM )
    import Data.Maybe
    import GHC.Float

    import GHC.Types.Basic
    import GHC.Types.ForeignCall
    import GHC.Data.FastString
    import GHC.Utils.Misc
    import GHC.Utils.Panic
    import GHC.Utils.Constants (debugIsOn)
    import GHC.Utils.Monad (mapAccumLM)

    -- Note [General layout of an NCG]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- @cmmTopCodeGen@ will be our main entry point to code gen.  Here we'll get
    -- @RawCmmDecl@; see GHC.Cmm
    --
    --   RawCmmDecl = GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    --
    --   GenCmmDecl d h g = CmmProc h CLabel [GlobalReg] g
    --                    | CmmData Section d
    --
    -- As a result we want to transform this to a list of @NatCmmDecl@, which is
    -- defined @GHC.CmmToAsm.Instr@ as
    --
    --   type NatCmmDecl statics instr
    --        = GenCmmDecl statics (LabelMap RawCmmStatics) (ListGraph instr)
    --
    -- Thus well' turn
    --   GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    -- into
    --   [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) (ListGraph Instr)]
    --
    -- where @CmmGraph@ is
    --
    --   type CmmGraph = GenCmmGraph CmmNode
    --   data GenCmmGraph n = CmmGraph { g_entry :: BlockId, g_graph :: Graph n C C }
    --   type CmmBlock = Block CmmNode C C
    --
    -- and @ListGraph Instr@ is
    --
    --   newtype ListGraph i = ListGraph [GenBasicBlock i]
    --   data GenBasicBlock i = BasicBlock BlockId [i]

    cmmTopCodeGen
        :: RawCmmDecl
        -> NatM [NatCmmDecl RawCmmStatics Instr]

    -- Thus we'll have to deal with either CmmProc ...
    cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl RawCmmStatics Instr]
    cmmTopCodeGen _cmm :: RawCmmDecl
    _cmm@(CmmProc LabelMap RawCmmStatics
    info CLabel
    lab [GlobalReg]
    live CmmGraph
    graph) = do
      -- do
      --   traceM $ "-- -------------------------- cmmTopGen (CmmProc) -------------------------- --\n"
      --         ++ showSDocUnsafe (ppr cmm)

      let blocks :: [Block CmmNode C C]
    blocks = CmmGraph -> [Block CmmNode C C]
    toBlockListEntryFirst CmmGraph
    graph
      (nat_blocks,statics) <- (Block CmmNode C C
     -> NatM ([NatBasicBlock Instr], [NatCmmDecl RawCmmStatics Instr]))
    -> [Block CmmNode C C]
    -> NatM
         ([[NatBasicBlock Instr]], [[NatCmmDecl RawCmmStatics Instr]])
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> m (b, c)) -> [a] -> m ([b], [c])
    mapAndUnzipM Block CmmNode C C
    -> NatM ([NatBasicBlock Instr], [NatCmmDecl RawCmmStatics Instr])
    basicBlockCodeGen [Block CmmNode C C]
    blocks
      picBaseMb <- getPicBaseMaybeNat

      let proc = LabelMap RawCmmStatics
    -> CLabel
    -> [GlobalReg]
    -> ListGraph Instr
    -> NatCmmDecl RawCmmStatics Instr
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc LabelMap RawCmmStatics
    info CLabel
    lab [GlobalReg]
    live ([NatBasicBlock Instr] -> ListGraph Instr
    forall i. [GenBasicBlock i] -> ListGraph i
    ListGraph ([NatBasicBlock Instr] -> ListGraph Instr)
    -> [NatBasicBlock Instr] -> ListGraph Instr
    forall a b. (a -> b) -> a -> b
    $ [[NatBasicBlock Instr]] -> [NatBasicBlock Instr]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[NatBasicBlock Instr]]
    nat_blocks)
          tops = NatCmmDecl RawCmmStatics Instr
    proc NatCmmDecl RawCmmStatics Instr
    -> [NatCmmDecl RawCmmStatics Instr]
    -> [NatCmmDecl RawCmmStatics Instr]
    forall a. a -> [a] -> [a]
    : [[NatCmmDecl RawCmmStatics Instr]]
    -> [NatCmmDecl RawCmmStatics Instr]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[NatCmmDecl RawCmmStatics Instr]]
    statics

      case picBaseMb of
          Just Reg
    _picBase -> String -> NatM [NatCmmDecl RawCmmStatics Instr]
    forall a. HasCallStack => String -> a
    panic String
    "AArch64.cmmTopCodeGen: picBase not implemented"
          Maybe Reg
    Nothing -> [NatCmmDecl RawCmmStatics Instr]
    -> NatM [NatCmmDecl RawCmmStatics Instr]
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [NatCmmDecl RawCmmStatics Instr]
    tops

    -- ... or CmmData.
    cmmTopCodeGen _cmm :: RawCmmDecl
    _cmm@(CmmData Section
    sec RawCmmStatics
    dat) = do
      -- do
      --   traceM $ "-- -------------------------- cmmTopGen (CmmData) -------------------------- --\n"
      --         ++ showSDocUnsafe (ppr cmm)
      [NatCmmDecl RawCmmStatics Instr]
    -> NatM [NatCmmDecl RawCmmStatics Instr]
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Section -> RawCmmStatics -> NatCmmDecl RawCmmStatics Instr
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData Section
    sec RawCmmStatics
    dat] -- no translation, we just use CmmStatic

    basicBlockCodeGen
            :: Block CmmNode C C
            -> NatM ( [NatBasicBlock Instr]
                    , [NatCmmDecl RawCmmStatics Instr])

    basicBlockCodeGen :: Block CmmNode C C
    -> NatM ([NatBasicBlock Instr], [NatCmmDecl RawCmmStatics Instr])
    basicBlockCodeGen Block CmmNode C C
    block = do
      config <- NatM NCGConfig
    getConfig
      -- do
      --   traceM $ "-- --------------------------- basicBlockCodeGen --------------------------- --\n"
      --         ++ showSDocUnsafe (ppr block)
      let (_, nodes, tail)  = blockSplit block
          id = Block CmmNode C C -> BlockId
    forall (x :: Extensibility). Block CmmNode C x -> BlockId
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> BlockId
    entryLabel Block CmmNode C C
    block
          stmts = Block CmmNode O O -> [CmmNode O O]
    forall (n :: Extensibility -> Extensibility -> *).
    Block n O O -> [n O O]
    blockToList Block CmmNode O O
    nodes

          header_comment_instr | Bool
    debugIsOn = Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ SDoc -> Instr
    MULTILINE_COMMENT (
              String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "-- --------------------------- basicBlockCodeGen --------------------------- --\n"
              SDoc -> SDoc -> SDoc
    $+$ PprStyle -> SDoc -> SDoc
    withPprStyle PprStyle
    defaultDumpStyle (Platform -> Block CmmNode C C -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc (NCGConfig -> Platform
    ncgPlatform NCGConfig
    config) Block CmmNode C C
    block)
              )
                               | Bool
    otherwise = OrdList Instr
    forall a. OrdList a
    nilOL
      -- Generate location directive
      dbg <- getDebugBlock (entryLabel block)
      loc_instrs <- case dblSourceTick =<< dbg of
        Just (SourceNote RealSrcSpan
    span (LexicalFastString FastString
    name))
          -> do fileId <- FastString -> NatM Int
    getFileId (RealSrcSpan -> FastString
    srcSpanFile RealSrcSpan
    span)
                let line = RealSrcSpan -> Int
    srcSpanStartLine RealSrcSpan
    span; col = RealSrcSpan -> Int
    srcSpanStartCol RealSrcSpan
    span
                return $ unitOL $ LOCATION fileId line col (unpackFS name)
        Maybe CmmTickish
    _ -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    forall a. OrdList a
    nilOL
      (mid_instrs,mid_bid) <- stmtsToInstrs id stmts
      (!tail_instrs,_) <- stmtToInstrs mid_bid tail
      let instrs = OrdList Instr
    header_comment_instr OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    loc_instrs OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    mid_instrs OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    tail_instrs
      -- TODO: Then x86 backend run @verifyBasicBlock@ here and inserts
      --      unwinding info. See Ticket 19913
      -- code generation may introduce new basic block boundaries, which
      -- are indicated by the NEWBLOCK instruction.  We must split up the
      -- instruction stream into basic blocks again. Also, we may extract
      -- LDATAs here too (if they are implemented by AArch64 again - See
      -- PPC how to do that.)
      let
            (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs

      return (BasicBlock id top : other_blocks, statics)

    mkBlocks :: Instr
              -> ([Instr], [GenBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
              -> ([Instr], [GenBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
    mkBlocks :: forall h g.
    Instr
    -> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
    -> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
    mkBlocks (NEWBLOCK BlockId
    id) ([Instr]
    instrs,[NatBasicBlock Instr]
    blocks,[GenCmmDecl RawCmmStatics h g]
    statics)
      = ([], BlockId -> [Instr] -> NatBasicBlock Instr
    forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    id [Instr]
    instrs NatBasicBlock Instr
    -> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
    forall a. a -> [a] -> [a]
    : [NatBasicBlock Instr]
    blocks, [GenCmmDecl RawCmmStatics h g]
    statics)
    mkBlocks Instr
    instr ([Instr]
    instrs,[NatBasicBlock Instr]
    blocks,[GenCmmDecl RawCmmStatics h g]
    statics)
      = (Instr
    instrInstr -> [Instr] -> [Instr]
    forall a. a -> [a] -> [a]
    :[Instr]
    instrs, [NatBasicBlock Instr]
    blocks, [GenCmmDecl RawCmmStatics h g]
    statics)
    -- -----------------------------------------------------------------------------
    -- | Utilities
    ann :: SDoc -> Instr -> Instr
    ann :: SDoc -> Instr -> Instr
    ann SDoc
    doc Instr
    instr {- debugIsOn -} = SDoc -> Instr -> Instr
    ANN SDoc
    doc Instr
    instr
    -- ann _ instr = instr
    {-# INLINE ann #-}

    -- Using pprExpr will hide the AST, @ANN@ will end up in the assembly with
    -- -dppr-debug.  The idea is that we can trivially see how a cmm expression
    -- ended up producing the assembly we see.  By having the verbatim AST printed
    -- we can simply check the patterns that were matched to arrive at the assembly
    -- we generated.
    --
    -- pprExpr will hide a lot of noise of the underlying data structure and print
    -- the expression into something that can be easily read by a human. However
    -- going back to the exact CmmExpr representation can be laborious and adds
    -- indirections to find the matches that lead to the assembly.
    --
    -- An improvement could be to have
    --
    --    (pprExpr genericPlatform e) <> parens (text. show e)
    --
    -- to have the best of both worlds.
    --
    -- Note: debugIsOn is too restrictive, it only works for debug compilers.
    -- However, we do not only want to inspect this for debug compilers. Ideally
    -- we'd have a check for -dppr-debug here already, such that we don't even
    -- generate the ANN expressions. However, as they are lazy, they shouldn't be
    -- forced until we actually force them, and without -dppr-debug they should
    -- never end up being forced.
    annExpr :: CmmExpr -> Instr -> Instr
    annExpr :: CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    e Instr
    instr {- debugIsOn -} = SDoc -> Instr -> Instr
    ANN (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (String -> SDoc) -> (CmmExpr -> String) -> CmmExpr -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmExpr -> String
    forall a. Show a => a -> String
    show (CmmExpr -> SDoc) -> CmmExpr -> SDoc
    forall a b. (a -> b) -> a -> b
    $ CmmExpr
    e) Instr
    instr
    -- annExpr e instr {- debugIsOn -} = ANN (pprExpr genericPlatform e) instr
    -- annExpr _ instr = instr
    {-# INLINE annExpr #-}

    -- -----------------------------------------------------------------------------
    -- Generating a table-branch

    -- TODO jump tables would be a lot faster, but we'll use bare bones for now.
    -- this is usually done by sticking the jump table ids into an instruction
    -- and then have the @generateJumpTableForInstr@ callback produce the jump
    -- table as a static.
    --
    -- See Ticket 19912
    --
    -- data SwitchTargets =
    --    SwitchTargets
    --        Bool                       -- Signed values
    --        (Integer, Integer)         -- Range
    --        (Maybe Label)              -- Default value
    --        (M.Map Integer Label)      -- The branches
    --
    -- Non Jumptable plan:
    -- xE <- expr
    --
    genSwitch :: CmmExpr -> SwitchTargets -> NatM InstrBlock
    genSwitch :: CmmExpr -> SwitchTargets -> NatM (OrdList Instr)
    genSwitch CmmExpr
    expr SwitchTargets
    targets = do -- pprPanic "genSwitch" (ppr expr)
      (reg, format, code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr
      let w = Format -> Width
    formatToWidth Format
    format
      let mkbranch OrdList Instr
    acc (Integer
    key, BlockId
    bid) = do
            (keyReg, _format, code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg (CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt Integer
    key Width
    w))
            return $ code `appOL`
                     toOL [ CMP (OpReg w reg) (OpReg w keyReg)
                          , BCOND EQ (TBlock bid)
                          ] `appOL` acc
          def_code = case SwitchTargets -> Maybe BlockId
    switchTargetsDefault SwitchTargets
    targets of
            Just BlockId
    bid -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Target -> Instr
    B (BlockId -> Target
    TBlock BlockId
    bid))
            Maybe BlockId
    Nothing  -> OrdList Instr
    forall a. OrdList a
    nilOL

      switch_code <- foldM mkbranch nilOL (switchTargetsCases targets)
      return $ code `appOL` switch_code `appOL` def_code

    -- We don't do jump tables for now, see Ticket 19912
    generateJumpTableForInstr :: NCGConfig -> Instr
      -> Maybe (NatCmmDecl RawCmmStatics Instr)
    generateJumpTableForInstr :: NCGConfig -> Instr -> Maybe (NatCmmDecl RawCmmStatics Instr)
    generateJumpTableForInstr NCGConfig
    _ Instr
    _ = Maybe (NatCmmDecl RawCmmStatics Instr)
    forall a. Maybe a
    Nothing

    -- -----------------------------------------------------------------------------
    -- Top-level of the instruction selector

    -- See Note [Keeping track of the current block] for why
    -- we pass the BlockId.
    stmtsToInstrs :: BlockId -- ^ Basic block these statement will start to be placed in.
                  -> [CmmNode O O] -- ^ Cmm Statement
                  -> NatM (InstrBlock, BlockId) -- ^ Resulting instruction
    stmtsToInstrs :: BlockId -> [CmmNode O O] -> NatM (OrdList Instr, BlockId)
    stmtsToInstrs BlockId
    bid [CmmNode O O]
    stmts =
        BlockId
    -> [CmmNode O O] -> OrdList Instr -> NatM (OrdList Instr, BlockId)
    forall {e :: Extensibility} {x :: Extensibility}.
    BlockId
    -> [CmmNode e x] -> OrdList Instr -> NatM (OrdList Instr, BlockId)
    go BlockId
    bid [CmmNode O O]
    stmts OrdList Instr
    forall a. OrdList a
    nilOL
      where
        go :: BlockId
    -> [CmmNode e x] -> OrdList Instr -> NatM (OrdList Instr, BlockId)
    go BlockId
    bid  []        OrdList Instr
    instrs = (OrdList Instr, BlockId) -> NatM (OrdList Instr, BlockId)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    instrs,BlockId
    bid)
        go BlockId
    bid (CmmNode e x
    s:[CmmNode e x]
    stmts)  OrdList Instr
    instrs = do
          (instrs',bid') <- BlockId -> CmmNode e x -> NatM (OrdList Instr, Maybe BlockId)
    forall (e :: Extensibility) (x :: Extensibility).
    BlockId -> CmmNode e x -> NatM (OrdList Instr, Maybe BlockId)
    stmtToInstrs BlockId
    bid CmmNode e x
    s
          -- If the statement introduced a new block, we use that one
          let !newBid = BlockId -> Maybe BlockId -> BlockId
    forall a. a -> Maybe a -> a
    fromMaybe BlockId
    bid Maybe BlockId
    bid'
          go newBid stmts (instrs `appOL` instrs')

    -- | `bid` refers to the current block and is used to update the CFG
    --   if new blocks are inserted in the control flow.
    -- See Note [Keeping track of the current block] for more details.
    stmtToInstrs :: BlockId -- ^ Basic block this statement will start to be placed in.
                 -> CmmNode e x
                 -> NatM (InstrBlock, Maybe BlockId)
                 -- ^ Instructions, and bid of new block if successive
                 -- statements are placed in a different basic block.
    stmtToInstrs :: forall (e :: Extensibility) (x :: Extensibility).
    BlockId -> CmmNode e x -> NatM (OrdList Instr, Maybe BlockId)
    stmtToInstrs BlockId
    bid CmmNode e x
    stmt = do
      -- traceM $ "-- -------------------------- stmtToInstrs -------------------------- --\n"
      --     ++ showSDocUnsafe (ppr stmt)
      platform <- NatM Platform
    getPlatform
      case stmt of
        CmmUnsafeForeignCall ForeignTarget
    target [CmmFormal]
    result_regs [CmmExpr]
    args
           -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> BlockId
    -> NatM (OrdList Instr, Maybe BlockId)
    genCCall ForeignTarget
    target [CmmFormal]
    result_regs [CmmExpr]
    args BlockId
    bid

        CmmNode e x
    _ -> (,Maybe BlockId
    forall a. Maybe a
    Nothing) (OrdList Instr -> (OrdList Instr, Maybe BlockId))
    -> NatM (OrdList Instr) -> NatM (OrdList Instr, Maybe BlockId)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> case CmmNode e x
    stmt of
          CmmComment FastString
    s   -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (SDoc -> Instr
    COMMENT (FastString -> SDoc
    forall doc. IsLine doc => FastString -> doc
    ftext FastString
    s)))
          CmmTick {}     -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    forall a. OrdList a
    nilOL

          CmmAssign CmmReg
    reg CmmExpr
    src
            | CmmType -> Bool
    isFloatType CmmType
    ty         -> Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_FltCode Format
    format CmmReg
    reg CmmExpr
    src
            | Bool
    otherwise              -> Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_IntCode Format
    format CmmReg
    reg CmmExpr
    src
              where ty :: CmmType
    ty = CmmReg -> CmmType
    cmmRegType CmmReg
    reg
                    format :: Format
    format = CmmType -> Format
    cmmTypeFormat CmmType
    ty

          CmmStore CmmExpr
    addr CmmExpr
    src AlignmentSpec
    _alignment
            | CmmType -> Bool
    isFloatType CmmType
    ty         -> Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_FltCode Format
    format CmmExpr
    addr CmmExpr
    src
            | Bool
    otherwise              -> Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_IntCode Format
    format CmmExpr
    addr CmmExpr
    src
              where ty :: CmmType
    ty = Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    src
                    format :: Format
    format = CmmType -> Format
    cmmTypeFormat CmmType
    ty

          CmmBranch BlockId
    id          -> BlockId -> NatM (OrdList Instr)
    genBranch BlockId
    id

          --We try to arrange blocks such that the likely branch is the fallthrough
          --in GHC.Cmm.ContFlowOpt. So we can assume the condition is likely false here.
          CmmCondBranch CmmExpr
    arg BlockId
    true BlockId
    false Maybe Bool
    _prediction ->
              BlockId -> BlockId -> BlockId -> CmmExpr -> NatM (OrdList Instr)
    genCondBranch BlockId
    bid BlockId
    true BlockId
    false CmmExpr
    arg

          CmmSwitch CmmExpr
    arg SwitchTargets
    ids -> CmmExpr -> SwitchTargets -> NatM (OrdList Instr)
    genSwitch CmmExpr
    arg SwitchTargets
    ids

          CmmCall { cml_target :: CmmNode O C -> CmmExpr
    cml_target = CmmExpr
    arg } -> CmmExpr -> NatM (OrdList Instr)
    genJump CmmExpr
    arg

          CmmUnwind [(GlobalReg, Maybe CmmExpr)]
    _regs -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    forall a. OrdList a
    nilOL

          CmmNode e x
    _ -> String -> SDoc -> NatM (OrdList Instr)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "stmtToInstrs: statement should have been cps'd away" (Platform -> CmmNode e x -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmNode e x
    stmt)

    --------------------------------------------------------------------------------
    -- | 'InstrBlock's are the insn sequences generated by the insn selectors.
    --      They are really trees of insns to facilitate fast appending, where a
    --      left-to-right traversal yields the insns in the correct order.
    --
    type InstrBlock
            = OrdList Instr

    -- | Register's passed up the tree.  If the stix code forces the register
    --      to live in a pre-decided machine register, it comes out as @Fixed@;
    --      otherwise, it comes out as @Any@, and the parent can decide which
    --      register to put it in.
    --
    data Register
            = Fixed Format Reg InstrBlock
            | Any   Format (Reg -> InstrBlock)

    -- | Sometimes we need to change the Format of a register. Primarily during
    -- conversion.
    swizzleRegisterRep :: Format -> Register -> Register
    swizzleRegisterRep :: Format -> Register -> Register
    swizzleRegisterRep Format
    format (Fixed Format
    _ Reg
    reg OrdList Instr
    code) = Format -> Reg -> OrdList Instr -> Register
    Fixed Format
    format Reg
    reg OrdList Instr
    code
    swizzleRegisterRep Format
    format (Any Format
    _ Reg -> OrdList Instr
    codefn)     = Format -> (Reg -> OrdList Instr) -> Register
    Any   Format
    format Reg -> OrdList Instr
    codefn

    -- | Grab the Reg for a CmmReg
    getRegisterReg :: Platform -> CmmReg -> Reg

    getRegisterReg :: Platform -> CmmReg -> Reg
    getRegisterReg Platform
    _ (CmmLocal (LocalReg Unique
    u CmmType
    pk))
      = VirtualReg -> Reg
    RegVirtual (VirtualReg -> Reg) -> VirtualReg -> Reg
    forall a b. (a -> b) -> a -> b
    $ Unique -> Format -> VirtualReg
    mkVirtualReg Unique
    u (CmmType -> Format
    cmmTypeFormat CmmType
    pk)

    getRegisterReg Platform
    platform (CmmGlobal reg :: GlobalRegUse
    reg@(GlobalRegUse GlobalReg
    mid CmmType
    _))
      = case Platform -> GlobalReg -> Maybe RealReg
    globalRegMaybe Platform
    platform GlobalReg
    mid of
            Just RealReg
    reg -> RealReg -> Reg
    RegReal RealReg
    reg
            Maybe RealReg
    Nothing  -> String -> SDoc -> Reg
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegisterReg-memory" (CmmReg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (CmmReg -> SDoc) -> CmmReg -> SDoc
    forall a b. (a -> b) -> a -> b
    $ GlobalRegUse -> CmmReg
    CmmGlobal GlobalRegUse
    reg)
            -- By this stage, the only MagicIds remaining should be the
            -- ones which map to a real machine register on this
            -- platform.  Hence if it's not mapped to a registers something
            -- went wrong earlier in the pipeline.
    -- | Convert a BlockId to some CmmStatic data
    -- TODO: Add JumpTable Logic, see Ticket 19912
    -- jumpTableEntry :: NCGConfig -> Maybe BlockId -> CmmStatic
    -- jumpTableEntry config Nothing   = CmmStaticLit (CmmInt 0 (ncgWordWidth config))
    -- jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
    --     where blockLabel = blockLbl blockid

    -- -----------------------------------------------------------------------------
    -- General things for putting together code sequences

    -- | The dual to getAnyReg: compute an expression into a register, but
    --      we don't mind which one it is.
    getSomeReg :: CmmExpr -> NatM (Reg, Format, InstrBlock)
    getSomeReg :: CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr = do
      r <- CmmExpr -> NatM Register
    getRegister CmmExpr
    expr
      case r of
        Any Format
    rep Reg -> OrdList Instr
    code -> do
            tmp <- Format -> NatM Reg
    getNewRegNat Format
    rep
            return (tmp, rep, code tmp)
        Fixed Format
    rep Reg
    reg OrdList Instr
    code ->
            (Reg, Format, OrdList Instr) -> NatM (Reg, Format, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    reg, Format
    rep, OrdList Instr
    code)

    {- Note [Aarch64 immediates]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Aarch64 with it's fixed width instruction encoding uses leftover space for
    immediates.
    If you want the full rundown consult the arch reference document:
    "Arm® Architecture Reference Manual" - "C3.4 Data processing - immediate"

    The gist of it is that different instructions allow for different immediate encodings.
    The ones we care about for better code generation are:

    * Simple but potentially repeated bit-patterns for logic instructions.
    * 16bit numbers shifted by multiples of 16.
    * 12 bit numbers optionally shifted by 12 bits.

    It might seem like the ISA allows for 64bit immediates but this isn't the case.
    Rather there are some instruction aliases which allow for large unencoded immediates
    which will then be transalted to one of the immediate encodings implicitly.

    For example mov x1, #0x10000 is allowed but will be assembled to movz x1, #0x1, lsl #16
    -}

    -- | Move (wide immediate)
    -- Allows for 16bit immediate which can be shifted by 0/16/32/48 bits.
    -- Used with MOVZ,MOVN, MOVK
    -- See Note [Aarch64 immediates]
    getMovWideImm :: Integer -> Width -> Maybe Operand
    getMovWideImm :: Integer -> Width -> Maybe Operand
    getMovWideImm Integer
    n Width
    w
      -- TODO: Handle sign extension/negatives
      | Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    0
      = Maybe Operand
    forall a. Maybe a
    Nothing
      -- Fits in 16 bits
      | Word64
    sized_n Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word64
    2Word64 -> Int -> Word64
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    16 :: Int)
      = Operand -> Maybe Operand
    forall a. a -> Maybe a
    Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
    forall a b. (a -> b) -> a -> b
    $ Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    truncated)

      -- 0x0000 0000 xxxx 0000
      | Int
    trailing_zeros Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    16 Bool -> Bool -> Bool
    && Word64
    sized_n Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word64
    2Word64 -> Int -> Word64
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    32 :: Int)
      = Operand -> Maybe Operand
    forall a. a -> Maybe a
    Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
    forall a b. (a -> b) -> a -> b
    $ Imm -> ShiftMode -> Int -> Operand
    OpImmShift (Integer -> Imm
    ImmInteger (Integer -> Imm) -> Integer -> Imm
    forall a b. (a -> b) -> a -> b
    $ Integer
    truncated Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16) ShiftMode
    SLSL Int
    16

      -- 0x 0000 xxxx 0000 0000
      | Int
    trailing_zeros Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    32 Bool -> Bool -> Bool
    && Word64
    sized_n Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word64
    2Word64 -> Int -> Word64
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    48 :: Int)
      = Operand -> Maybe Operand
    forall a. a -> Maybe a
    Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
    forall a b. (a -> b) -> a -> b
    $ Imm -> ShiftMode -> Int -> Operand
    OpImmShift (Integer -> Imm
    ImmInteger (Integer -> Imm) -> Integer -> Imm
    forall a b. (a -> b) -> a -> b
    $ Integer
    truncated Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    32) ShiftMode
    SLSL Int
    32

      -- 0x xxxx 0000 0000 0000
      | Int
    trailing_zeros Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    48
      = Operand -> Maybe Operand
    forall a. a -> Maybe a
    Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
    forall a b. (a -> b) -> a -> b
    $ Imm -> ShiftMode -> Int -> Operand
    OpImmShift (Integer -> Imm
    ImmInteger (Integer -> Imm) -> Integer -> Imm
    forall a b. (a -> b) -> a -> b
    $ Integer
    truncated Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    48) ShiftMode
    SLSL Int
    48

      | Bool
    otherwise
      = Maybe Operand
    forall a. Maybe a
    Nothing
      where
        truncated :: Integer
    truncated = Width -> Integer -> Integer
    narrowU Width
    w Integer
    n
        sized_n :: Word64
    sized_n = Integer -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    truncated :: Word64
        trailing_zeros :: Int
    trailing_zeros = Word64 -> Int
    forall b. FiniteBits b => b -> Int
    countTrailingZeros Word64
    sized_n

    -- | Arithmetic(immediate)
    --  Allows for 12bit immediates which can be shifted by 0 or 12 bits.
    -- Used with ADD, ADDS, SUB, SUBS, CMP
    -- See Note [Aarch64 immediates]
    getArithImm :: Integer -> Width -> Maybe Operand
    getArithImm :: Integer -> Width -> Maybe Operand
    getArithImm Integer
    n Width
    w
      -- TODO: Handle sign extension
      | Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    0
      = Maybe Operand
    forall a. Maybe a
    Nothing
      -- Fits in 16 bits
      -- Fits in 12 bits
      | Word64
    sized_n Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word64
    2Word64 -> Int -> Word64
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    12::Int)
      = Operand -> Maybe Operand
    forall a. a -> Maybe a
    Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
    forall a b. (a -> b) -> a -> b
    $ Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    truncated)

      -- 12 bits shifted by 12 places.
      | Int
    trailing_zeros Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    12 Bool -> Bool -> Bool
    && Word64
    sized_n Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word64
    2Word64 -> Int -> Word64
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    24::Int)
      = Operand -> Maybe Operand
    forall a. a -> Maybe a
    Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
    forall a b. (a -> b) -> a -> b
    $ Imm -> ShiftMode -> Int -> Operand
    OpImmShift (Integer -> Imm
    ImmInteger (Integer -> Imm) -> Integer -> Imm
    forall a b. (a -> b) -> a -> b
    $ Integer
    truncated Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    12) ShiftMode
    SLSL Int
    12

      | Bool
    otherwise
      = Maybe Operand
    forall a. Maybe a
    Nothing
      where
        sized_n :: Word64
    sized_n = Integer -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    truncated :: Word64
        truncated :: Integer
    truncated = Width -> Integer -> Integer
    narrowU Width
    w Integer
    n
        trailing_zeros :: Int
    trailing_zeros = Word64 -> Int
    forall b. FiniteBits b => b -> Int
    countTrailingZeros Word64
    sized_n

    -- |  Logical (immediate)
    -- Allows encoding of some repeated bitpatterns
    -- Used with AND, EOR, ORR
    -- and their aliases which includes at least MOV (bitmask immediate)
    -- See Note [Aarch64 immediates]
    getBitmaskImm :: Integer -> Width -> Maybe Operand
    getBitmaskImm :: Integer -> Width -> Maybe Operand
    getBitmaskImm Integer
    n Width
    w
      | Width -> Integer -> Bool
    isAArch64Bitmask (Width -> Width
    opRegWidth Width
    w) Integer
    truncated = Operand -> Maybe Operand
    forall a. a -> Maybe a
    Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
    forall a b. (a -> b) -> a -> b
    $ Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    truncated)
      | Bool
    otherwise = Maybe Operand
    forall a. Maybe a
    Nothing
      where
        truncated :: Integer
    truncated = Width -> Integer -> Integer
    narrowU Width
    w Integer
    n

    -- | Load/store immediate.
    -- Depends on the width of the store to some extent.
    isOffsetImm :: Int -> Width -> Bool
    isOffsetImm :: Int -> Width -> Bool
    isOffsetImm Int
    off Width
    w
      -- 8 bits + sign for unscaled offsets
      | -Int
    256 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    off, Int
    off Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    255 = Bool
    True
      -- Offset using 12-bit positive immediate, scaled by width
      -- LDR/STR: imm12: if reg is 32bit: 0 -- 16380 in multiples of 4
      -- LDR/STR: imm12: if reg is 64bit: 0 -- 32760 in multiples of 8
      -- 16-bit: 0 .. 8188, 8-bit: 0 -- 4095
      | Int
    0 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    off, Int
    off Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    4096 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    byte_width, Int
    off Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    byte_width Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = Bool
    True
      | Bool
    otherwise = Bool
    False
      where
        byte_width :: Int
    byte_width = Width -> Int
    widthInBytes Width
    w

    -- TODO OPT: we might be able give getRegister
    --          a hint, what kind of register we want.
    getFloatReg :: HasCallStack => CmmExpr -> NatM (Reg, Format, InstrBlock)
    getFloatReg :: HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getFloatReg CmmExpr
    expr = do
      r <- CmmExpr -> NatM Register
    getRegister CmmExpr
    expr
      case r of
        Any Format
    rep Reg -> OrdList Instr
    code | Format -> Bool
    isFloatFormat Format
    rep -> do
          tmp <- Format -> NatM Reg
    getNewRegNat Format
    rep
          return (tmp, rep, code tmp)
        Any Format
    II32 Reg -> OrdList Instr
    code -> do
          tmp <- Format -> NatM Reg
    getNewRegNat Format
    FF32
          return (tmp, FF32, code tmp)
        Any Format
    II64 Reg -> OrdList Instr
    code -> do
          tmp <- Format -> NatM Reg
    getNewRegNat Format
    FF64
          return (tmp, FF64, code tmp)
        Any Format
    _w Reg -> OrdList Instr
    _code -> do
          config <- NatM NCGConfig
    getConfig
          pprPanic "can't do getFloatReg on" (pdoc (ncgPlatform config) expr)
        -- can't do much for fixed.
        Fixed Format
    rep Reg
    reg OrdList Instr
    code ->
          (Reg, Format, OrdList Instr) -> NatM (Reg, Format, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    reg, Format
    rep, OrdList Instr
    code)

    -- TODO: TODO, bounds. We can't put any immediate
    -- value in. They are constrained.
    -- See Ticket 19911
    litToImm' :: CmmLit -> NatM (Operand, InstrBlock)
    litToImm' :: CmmLit -> NatM (Operand, OrdList Instr)
    litToImm' CmmLit
    lit = (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Imm -> Operand
    OpImm (CmmLit -> Imm
    litToImm CmmLit
    lit), OrdList Instr
    forall a. OrdList a
    nilOL)

    getRegister :: CmmExpr -> NatM Register
    getRegister :: CmmExpr -> NatM Register
    getRegister CmmExpr
    e = do
      config <- NatM NCGConfig
    getConfig
      getRegister' config (ncgPlatform config) e

    -- | The register width to be used for an operation on the given width
    -- operand.
    opRegWidth :: Width -> Width
    opRegWidth :: Width -> Width
    opRegWidth Width
    W64 = Width
    W64  -- x
    opRegWidth Width
    W32 = Width
    W32  -- w
    opRegWidth Width
    W16 = Width
    W32  -- w
    opRegWidth Width
    W8  = Width
    W32  -- w
    opRegWidth Width
    w   = String -> SDoc -> Width
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "opRegWidth" (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Unsupported width" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w)

    -- Note [Signed arithmetic on AArch64]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- Handling signed arithmetic on sub-word-size values on AArch64 is a bit
    -- tricky as Cmm's type system does not capture signedness. While 32-bit values
    -- are fairly easy to handle due to AArch64's 32-bit instruction variants
    -- (denoted by use of %wN registers), 16- and 8-bit values require quite some
    -- care.
    --
    -- We handle 16-and 8-bit values by using the 32-bit operations and
    -- sign-/zero-extending operands and truncate results as necessary. For
    -- simplicity we maintain the invariant that a register containing a
    -- sub-word-size value always contains the zero-extended form of that value
    -- in between operations.
    --
    -- For instance, consider the program,
    --
    --    test(bits64 buffer)
    --      bits8 a = bits8[buffer];
    --      bits8 b = %mul(a, 42);
    --      bits8 c = %not(b);
    --      bits8 d = %shrl(c, 4::bits8);
    --      return (d);
    --    }
    --
    -- This program begins by loading `a` from memory, for which we use a
    -- zero-extended byte-size load.  We next sign-extend `a` to 32-bits, and use a
    -- 32-bit multiplication to compute `b`, and truncate the result back down to
    -- 8-bits.
    --
    -- Next we compute `c`: The `%not` requires no extension of its operands, but
    -- we must still truncate the result back down to 8-bits. Finally the `%shrl`
    -- requires no extension and no truncate since we can assume that
    -- `c` is zero-extended.
    --
    -- TODO:
    --   Don't use Width in Operands
    --   Instructions should rather carry a RegWidth
    --
    -- Note [Handling PIC on AArch64]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- AArch64 does not have a special PIC register, the general approach is to
    -- simply go through the GOT, and there is assembly support for this:
    --
    --   // Load the address of 'sym' from the GOT using ADRP and LDR (used for
    --   // position-independent code on AArch64):
    --   adrp x0, #:got:sym
    --   ldr x0, [x0, #:got_lo12:sym]
    --
    -- See also: https://developer.arm.com/documentation/dui0774/i/armclang-integrated-assembler-directives/assembly-expressions
    --
    -- CmmGlobal @PicBaseReg@'s are generated in @GHC.CmmToAsm.PIC@ in the
    -- @cmmMakePicReference@.  This is in turn called from @cmmMakeDynamicReference@
    -- also in @Cmm.CmmToAsm.PIC@ from where it is also exported.  There are two
    -- callsites for this. One is in this module to produce the @target@ in @genCCall@
    -- the other is in @GHC.CmmToAsm@ in @cmmExprNative@.
    --
    -- Conceptually we do not want any special PicBaseReg to be used on AArch64. If
    -- we want to distinguish between symbol loading, we need to address this through
    -- the way we load it, not through a register.
    --

    getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register
    -- OPTIMIZATION WARNING: CmmExpr rewrites
    -- 1. Rewrite: Reg + (-n) => Reg - n
    --    TODO: this expression shouldn't even be generated to begin with.
    getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    plat (CmmMachOp (MO_Add Width
    w0) [CmmExpr
    x, CmmLit (CmmInt Integer
    i Width
    w1)]) | Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0
      = NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    plat (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_Sub Width
    w0) [CmmExpr
    x, CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt (-Integer
    i) Width
    w1)])

    getRegister' NCGConfig
    config Platform
    plat (CmmMachOp (MO_Sub Width
    w0) [CmmExpr
    x, CmmLit (CmmInt Integer
    i Width
    w1)]) | Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0
      = NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    plat (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_Add Width
    w0) [CmmExpr
    x, CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt (-Integer
    i) Width
    w1)])

    -- Generic case.
    getRegister' NCGConfig
    config Platform
    plat CmmExpr
    expr
      = case CmmExpr
    expr of
        CmmReg (CmmGlobal (GlobalRegUse GlobalReg
    PicBaseReg CmmType
    _))
          -> String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegisterReg-memory" (GlobalReg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (GlobalReg -> SDoc) -> GlobalReg -> SDoc
    forall a b. (a -> b) -> a -> b
    $ GlobalReg
    PicBaseReg)
        CmmLit CmmLit
    lit
          -> case CmmLit
    lit of

            -- Use wzr xzr for CmmInt 0 if the width matches up, otherwise do a move.
            -- TODO: Reenable after https://gitlab.haskell.org/ghc/ghc/-/issues/23632 is fixed.
            -- CmmInt 0 W32 -> do
            --   let format = intFormat W32
            --   return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) ))
            -- CmmInt 0 W64 -> do
            --   let format = intFormat W64
            --   return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) ))
            CmmInt Integer
    i Width
    W8 | Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    0 -> do
              Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    W8) (\Reg
    dst -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    W8 Reg
    dst) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger (Width -> Integer -> Integer
    narrowU Width
    W8 Integer
    i))))))
            CmmInt Integer
    i Width
    W16 | Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    0 -> do
              Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    W16) (\Reg
    dst -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    W16 Reg
    dst) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger (Width -> Integer -> Integer
    narrowU Width
    W16 Integer
    i))))))

            CmmInt Integer
    i Width
    W8  -> do
              Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    W8) (\Reg
    dst -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    W8 Reg
    dst) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger (Width -> Integer -> Integer
    narrowU Width
    W8 Integer
    i))))))
            CmmInt Integer
    i Width
    W16 -> do
              Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    W16) (\Reg
    dst -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    W16 Reg
    dst) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger (Width -> Integer -> Integer
    narrowU Width
    W16 Integer
    i))))))

            -- We need to be careful to not shorten this for negative literals.
            -- Those need the upper bits set. We'd either have to explicitly sign
            -- or figure out something smarter. Lowered to
            -- `MOV dst XZR`
            CmmInt Integer
    i Width
    w | Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    0
                       , Just Operand
    imm_op <- Integer -> Width -> Maybe Operand
    getMovWideImm Integer
    i Width
    w -> do
              Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    w) (\Reg
    dst -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Instr
    MOVZ (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) Operand
    imm_op)))

            CmmInt Integer
    i Width
    w | Int -> Integer -> Bool
    isNbitEncodeable Int
    16 Integer
    i, Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    0 -> do
              Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    w) (\Reg
    dst -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    W16 Reg
    dst) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    i)))))

            CmmInt Integer
    i Width
    w | Int -> Integer -> Bool
    isNbitEncodeable Int
    32 Integer
    i, Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    0 -> do
              let  half0 :: Int
    half0 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    i :: Word16)
                   half1 :: Int
    half1 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer
    i Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16) :: Word16)
              Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    w) (\Reg
    dst -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr
                                                      (Instr -> Instr) -> Instr -> Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    dst) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    half0))
                                                      , Operand -> Operand -> Instr
    MOVK (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    dst) (Imm -> ShiftMode -> Int -> Operand
    OpImmShift (Int -> Imm
    ImmInt Int
    half1) ShiftMode
    SLSL Int
    16)
                                                      ]))
            -- fallback for W32
            CmmInt Integer
    i Width
    W32 -> do
              let  half0 :: Int
    half0 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    i :: Word16)
                   half1 :: Int
    half1 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer
    i Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16) :: Word16)
              Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    W32) (\Reg
    dst -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr
                                                        (Instr -> Instr) -> Instr -> Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    dst) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    half0))
                                                        , Operand -> Operand -> Instr
    MOVK (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    dst) (Imm -> ShiftMode -> Int -> Operand
    OpImmShift (Int -> Imm
    ImmInt Int
    half1) ShiftMode
    SLSL Int
    16)
                                                        ]))
            -- anything else
            CmmInt Integer
    i Width
    W64 -> do
              let  half0 :: Int
    half0 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    i :: Word16)
                   half1 :: Int
    half1 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer
    i Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16) :: Word16)
                   half2 :: Int
    half2 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer
    i Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    32) :: Word16)
                   half3 :: Int
    half3 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer
    i Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    48) :: Word16)
              Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    W64) (\Reg
    dst -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr
                                                        (Instr -> Instr) -> Instr -> Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    dst) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    half0))
                                                        , Operand -> Operand -> Instr
    MOVK (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    dst) (Imm -> ShiftMode -> Int -> Operand
    OpImmShift (Int -> Imm
    ImmInt Int
    half1) ShiftMode
    SLSL Int
    16)
                                                        , Operand -> Operand -> Instr
    MOVK (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    dst) (Imm -> ShiftMode -> Int -> Operand
    OpImmShift (Int -> Imm
    ImmInt Int
    half2) ShiftMode
    SLSL Int
    32)
                                                        , Operand -> Operand -> Instr
    MOVK (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    dst) (Imm -> ShiftMode -> Int -> Operand
    OpImmShift (Int -> Imm
    ImmInt Int
    half3) ShiftMode
    SLSL Int
    48)
                                                        ]))
            CmmInt Integer
    _i Width
    rep -> do
              (op, imm_code) <- CmmLit -> NatM (Operand, OrdList Instr)
    litToImm' CmmLit
    lit
              return (Any (intFormat rep) (\Reg
    dst -> OrdList Instr
    imm_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    rep Reg
    dst) Operand
    op)))

            -- floatToBytes (fromRational f)
            CmmFloat Rational
    0 Width
    w   -> do
              (op, imm_code) <- CmmLit -> NatM (Operand, OrdList Instr)
    litToImm' CmmLit
    lit
              return (Any (floatFormat w) (\Reg
    dst -> OrdList Instr
    imm_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) Operand
    op)))

            CmmFloat Rational
    _f Width
    W8  -> String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister' (CmmLit:CmmFloat), no support for bytes" (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)
            CmmFloat Rational
    _f Width
    W16 -> String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister' (CmmLit:CmmFloat), no support for halfs" (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)
            CmmFloat Rational
    f Width
    W32 -> do
              let word :: Word32
    word = Float -> Word32
    castFloatToWord32 (Rational -> Float
    forall a. Fractional a => Rational -> a
    fromRational Rational
    f) :: Word32
                  half0 :: Int
    half0 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    word :: Word16)
                  half1 :: Int
    half1 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32
    word Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16) :: Word16)
              tmp <- Format -> NatM Reg
    getNewRegNat (Width -> Format
    intFormat Width
    W32)
              return (Any (floatFormat W32) (\Reg
    dst -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr
                                                          (Instr -> Instr) -> Instr -> Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    tmp) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    half0))
                                                          , Operand -> Operand -> Instr
    MOVK (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    tmp) (Imm -> ShiftMode -> Int -> Operand
    OpImmShift (Int -> Imm
    ImmInt Int
    half1) ShiftMode
    SLSL Int
    16)
                                                          , Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    tmp)
                                                          ]))
            CmmFloat Rational
    f Width
    W64 -> do
              let word :: Word64
    word = Double -> Word64
    castDoubleToWord64 (Rational -> Double
    forall a. Fractional a => Rational -> a
    fromRational Rational
    f) :: Word64
                  half0 :: Int
    half0 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word64
    word :: Word16)
                  half1 :: Int
    half1 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64
    word Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16) :: Word16)
                  half2 :: Int
    half2 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64
    word Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    32) :: Word16)
                  half3 :: Int
    half3 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64
    word Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    48) :: Word16)
              tmp <- Format -> NatM Reg
    getNewRegNat (Width -> Format
    intFormat Width
    W64)
              return (Any (floatFormat W64) (\Reg
    dst -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr
                                                          (Instr -> Instr) -> Instr -> Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    tmp) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    half0))
                                                          , Operand -> Operand -> Instr
    MOVK (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    tmp) (Imm -> ShiftMode -> Int -> Operand
    OpImmShift (Int -> Imm
    ImmInt Int
    half1) ShiftMode
    SLSL Int
    16)
                                                          , Operand -> Operand -> Instr
    MOVK (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    tmp) (Imm -> ShiftMode -> Int -> Operand
    OpImmShift (Int -> Imm
    ImmInt Int
    half2) ShiftMode
    SLSL Int
    32)
                                                          , Operand -> Operand -> Instr
    MOVK (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    tmp) (Imm -> ShiftMode -> Int -> Operand
    OpImmShift (Int -> Imm
    ImmInt Int
    half3) ShiftMode
    SLSL Int
    48)
                                                          , Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    tmp)
                                                          ]))
            CmmFloat Rational
    _f Width
    _w -> String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister' (CmmLit:CmmFloat), unsupported float lit" (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)
            CmmVec [CmmLit]
    _ -> String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister' (CmmLit:CmmVec): " (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)
            CmmLabel CLabel
    _lbl -> do
              (op, imm_code) <- CmmLit -> NatM (Operand, OrdList Instr)
    litToImm' CmmLit
    lit
              let rep = Platform -> CmmLit -> CmmType
    cmmLitType Platform
    plat CmmLit
    lit
                  format = CmmType -> Format
    cmmTypeFormat CmmType
    rep
              return (Any format (\Reg
    dst -> OrdList Instr
    imm_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` (CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Instr -> Instr) -> Instr -> Instr
    forall a b. (a -> b) -> a -> b
    $ Format -> Operand -> Operand -> Instr
    LDR Format
    format (Width -> Reg -> Operand
    OpReg (Format -> Width
    formatToWidth Format
    format) Reg
    dst) Operand
    op)))

            CmmLabelOff CLabel
    _lbl Int
    off | Int -> Integer -> Bool
    isNbitEncodeable Int
    12 (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    off) -> do
              (op, imm_code) <- CmmLit -> NatM (Operand, OrdList Instr)
    litToImm' CmmLit
    lit
              let rep = Platform -> CmmLit -> CmmType
    cmmLitType Platform
    plat CmmLit
    lit
                  format = CmmType -> Format
    cmmTypeFormat CmmType
    rep
              return (Any format (\Reg
    dst -> OrdList Instr
    imm_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Operand -> Operand -> Instr
    LDR Format
    format (Width -> Reg -> Operand
    OpReg (Format -> Width
    formatToWidth Format
    format) Reg
    dst) Operand
    op))

            CmmLabelOff CLabel
    lbl Int
    off -> do
              (op, imm_code) <- CmmLit -> NatM (Operand, OrdList Instr)
    litToImm' (CLabel -> CmmLit
    CmmLabel CLabel
    lbl)
              let rep = Platform -> CmmLit -> CmmType
    cmmLitType Platform
    plat CmmLit
    lit
                  format = CmmType -> Format
    cmmTypeFormat CmmType
    rep
                  width = CmmType -> Width
    typeWidth CmmType
    rep
              (off_r, _off_format, off_code) <- getSomeReg $ CmmLit (CmmInt (fromIntegral off) width)
              return (Any format (\Reg
    dst -> OrdList Instr
    imm_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    off_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Operand -> Operand -> Instr
    LDR Format
    format (Width -> Reg -> Operand
    OpReg (Format -> Width
    formatToWidth Format
    format) Reg
    dst) Operand
    op OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Operand -> Operand -> Operand -> Instr
    ADD (Width -> Reg -> Operand
    OpReg Width
    width Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    width Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    width Reg
    off_r)))

            CmmLabelDiffOff CLabel
    _ CLabel
    _ Int
    _ Width
    _ -> String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister' (CmmLit:CmmLabelOff): " (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)
            CmmBlock BlockId
    _ -> String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister' (CmmLit:CmmLabelOff): " (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)
            CmmLit
    CmmHighStackMark -> String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister' (CmmLit:CmmLabelOff): " (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)
        CmmLoad CmmExpr
    mem CmmType
    rep AlignmentSpec
    _ -> do
          Amode addr addr_code <- Platform -> Width -> CmmExpr -> NatM Amode
    getAmode Platform
    plat (CmmType -> Width
    typeWidth CmmType
    rep) CmmExpr
    mem
          let format = CmmType -> Format
    cmmTypeFormat CmmType
    rep
          return (Any format (\Reg
    dst -> OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Operand -> Operand -> Instr
    LDR Format
    format (Width -> Reg -> Operand
    OpReg (Format -> Width
    formatToWidth Format
    format) Reg
    dst) (AddrMode -> Operand
    OpAddr AddrMode
    addr)))
        CmmStackSlot Area
    _ Int
    _
          -> String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister' (CmmStackSlot): " (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)
        CmmReg CmmReg
    reg
          -> Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> Reg -> OrdList Instr -> Register
    Fixed (CmmType -> Format
    cmmTypeFormat (CmmReg -> CmmType
    cmmRegType CmmReg
    reg))
                           (Platform -> CmmReg -> Reg
    getRegisterReg Platform
    plat CmmReg
    reg)
                           OrdList Instr
    forall a. OrdList a
    nilOL)
        CmmRegOff CmmReg
    reg Int
    off ->
          -- If we got here we will load the address into a register either way. So we might as well just expand
          -- and re-use the existing code path to handle "reg + off".
          let !width :: Width
    width = CmmReg -> Width
    cmmRegWidth CmmReg
    reg
          in NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    plat (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_Add Width
    width) [CmmReg -> CmmExpr
    CmmReg CmmReg
    reg, CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    off) Width
    width)])

        -- for MachOps, see GHC.Cmm.MachOp
        -- For CmmMachOp, see GHC.Cmm.Expr

        -- Handle MO_RelaxedRead as a normal CmmLoad, to allow
        -- non-trivial addressing modes to be used.
        CmmMachOp (MO_RelaxedRead Width
    w) [CmmExpr
    e] ->
          CmmExpr -> NatM Register
    getRegister (CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
    CmmLoad CmmExpr
    e (Width -> CmmType
    cmmBits Width
    w) AlignmentSpec
    NaturallyAligned)

        CmmMachOp MachOp
    op [CmmExpr
    e] -> do
          (reg, _format, code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    e
          case op of
            MO_Not Width
    w -> Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    w) ((Reg -> OrdList Instr) -> Register)
    -> (Reg -> OrdList Instr) -> Register
    forall a b. (a -> b) -> a -> b
    $ \Reg
    dst ->
                let w' :: Width
    w' = Width -> Width
    opRegWidth Width
    w
                 in OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                    Operand -> Operand -> Instr
    MVN (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    reg) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    Width -> Width -> Reg -> OrdList Instr
    truncateReg Width
    w' Width
    w Reg
    dst -- See Note [Signed arithmetic on AArch64]

            MO_S_Neg Width
    w -> OrdList Instr -> Width -> Reg -> NatM Register
    negate OrdList Instr
    code Width
    w Reg
    reg
            MO_F_Neg Width
    w -> Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    floatFormat Width
    w) (\Reg
    dst -> OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Operand -> Operand -> Instr
    NEG (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg))

            MO_SF_Conv Width
    from Width
    to -> Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    floatFormat Width
    to) (\Reg
    dst -> OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Operand -> Operand -> Instr
    SCVTF (Width -> Reg -> Operand
    OpReg Width
    to Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    from Reg
    reg))  -- (Signed ConVerT Float)
            MO_FS_Conv Width
    from Width
    to -> Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    to) (\Reg
    dst -> OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Operand -> Operand -> Instr
    FCVTZS (Width -> Reg -> Operand
    OpReg Width
    to Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    from Reg
    reg)) -- (float convert (-> zero) signed)

            -- TODO this is very hacky
            -- Note, UBFM and SBFM expect source and target register to be of the same size, so we'll use @max from to@
            -- UBFM will set the high bits to 0. SBFM will copy the sign (sign extend).
            MO_UU_Conv Width
    from Width
    to -> Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    to) (\Reg
    dst -> OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Operand -> Operand -> Operand -> Operand -> Instr
    UBFM (Width -> Reg -> Operand
    OpReg (Width -> Width -> Width
    forall a. Ord a => a -> a -> a
    max Width
    from Width
    to) Reg
    dst) (Width -> Reg -> Operand
    OpReg (Width -> Width -> Width
    forall a. Ord a => a -> a -> a
    max Width
    from Width
    to) Reg
    reg) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    0)) (Width -> Operand
    toImm (Width -> Width -> Width
    forall a. Ord a => a -> a -> a
    min Width
    from Width
    to)))
            MO_SS_Conv Width
    from Width
    to -> Width -> Width -> Reg -> OrdList Instr -> NatM Register
    forall {m :: * -> *}.
    Monad m =>
    Width -> Width -> Reg -> OrdList Instr -> m Register
    ss_conv Width
    from Width
    to Reg
    reg OrdList Instr
    code
            MO_FF_Conv Width
    from Width
    to -> Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    floatFormat Width
    to) (\Reg
    dst -> OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Operand -> Operand -> Instr
    FCVT (Width -> Reg -> Operand
    OpReg Width
    to Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    from Reg
    reg))

            -- Conversions
            MO_XX_Conv Width
    _from Width
    to -> Format -> Register -> Register
    swizzleRegisterRep (Width -> Format
    intFormat Width
    to) (Register -> Register) -> NatM Register -> NatM Register
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CmmExpr -> NatM Register
    getRegister CmmExpr
    e

            MachOp
    _ -> String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister' (monadic CmmMachOp):" (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)
          where
            toImm :: Width -> Operand
    toImm Width
    W8 =  (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    7))
            toImm Width
    W16 = (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    15))
            toImm Width
    W32 = (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    31))
            toImm Width
    W64 = (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    63))
            toImm Width
    W128 = (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    127))
            toImm Width
    W256 = (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    255))
            toImm Width
    W512 = (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    511))

            -- In the case of 16- or 8-bit values we need to sign-extend to 32-bits
            -- See Note [Signed arithmetic on AArch64].
            negate :: OrdList Instr -> Width -> Reg -> NatM Register
    negate OrdList Instr
    code Width
    w Reg
    reg = do
                let w' :: Width
    w' = Width -> Width
    opRegWidth Width
    w
                (reg', code_sx) <- Width -> Width -> Reg -> NatM (Reg, OrdList Instr)
    signExtendReg Width
    w Width
    w' Reg
    reg
                return $ Any (intFormat w) $ \Reg
    dst ->
                    OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    OrdList Instr
    code_sx OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                    Operand -> Operand -> Instr
    NEG (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    reg') OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    Width -> Width -> Reg -> OrdList Instr
    truncateReg Width
    w' Width
    w Reg
    dst

            ss_conv :: Width -> Width -> Reg -> OrdList Instr -> m Register
    ss_conv Width
    from Width
    to Reg
    reg OrdList Instr
    code =
                let w' :: Width
    w' = Width -> Width
    opRegWidth (Width -> Width -> Width
    forall a. Ord a => a -> a -> a
    max Width
    from Width
    to)
                in Register -> m Register
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> m Register) -> Register -> m Register
    forall a b. (a -> b) -> a -> b
    $ Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    to) ((Reg -> OrdList Instr) -> Register)
    -> (Reg -> OrdList Instr) -> Register
    forall a b. (a -> b) -> a -> b
    $ \Reg
    dst ->
                    OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                    Operand -> Operand -> Operand -> Operand -> Instr
    SBFM (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    reg) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    0)) (Width -> Operand
    toImm (Width -> Width -> Width
    forall a. Ord a => a -> a -> a
    min Width
    from Width
    to)) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    -- At this point an 8- or 16-bit value would be sign-extended
                    -- to 32-bits. Truncate back down the final width.
                    Width -> Width -> Reg -> OrdList Instr
    truncateReg Width
    w' Width
    to Reg
    dst

        -- Dyadic machops:
        --
        -- The general idea is:
        -- compute x<i> <- x
        -- compute x<j> <- y
        -- OP x<r>, x<i>, x<j>
        --
        -- TODO: for now we'll only implement the 64bit versions. And rely on the
        --      fallthrough to alert us if things go wrong!
        -- OPTIMIZATION WARNING: Dyadic CmmMachOp destructuring
        -- 0. TODO This should not exist! Rewrite: Reg +- 0 -> Reg
        CmmMachOp (MO_Add Width
    _) [expr' :: CmmExpr
    expr'@(CmmReg (CmmGlobal GlobalRegUse
    _r)), CmmLit (CmmInt Integer
    0 Width
    _)] -> NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    plat CmmExpr
    expr'
        CmmMachOp (MO_Sub Width
    _) [expr' :: CmmExpr
    expr'@(CmmReg (CmmGlobal GlobalRegUse
    _r)), CmmLit (CmmInt Integer
    0 Width
    _)] -> NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    plat CmmExpr
    expr'
        -- Immediates are handled via `getArithImm` in the generic code path.

        CmmMachOp (MO_U_Quot Width
    w) [CmmExpr
    x, CmmExpr
    y] | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8 -> do
          (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) (\Reg
    dst -> OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Instr
    UXTB (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x)) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                                                            (Operand -> Operand -> Instr
    UXTB (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y)) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                                                            (Operand -> Operand -> Operand -> Instr
    UDIV (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y)))
        CmmMachOp (MO_U_Quot Width
    w) [CmmExpr
    x, CmmExpr
    y] | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W16 -> do
          (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) (\Reg
    dst -> OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Instr
    UXTH (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x)) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                                                            (Operand -> Operand -> Instr
    UXTH (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y)) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                                                            (Operand -> Operand -> Operand -> Instr
    UDIV (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y)))

        -- 2. Shifts. x << n, x >> n.
        CmmMachOp (MO_Shl Width
    w) [CmmExpr
    x, (CmmLit (CmmInt Integer
    n Width
    _))]
          | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W32 Bool -> Bool -> Bool
    || Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64
          , Integer
    0 Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    n, Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Width -> Int
    widthInBits Width
    w) -> do
          (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          return $ Any (intFormat w) (\Reg
    dst -> OrdList Instr
    code_x OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    LSL (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    n))))

        CmmMachOp (MO_S_Shr Width
    w) [CmmExpr
    x, (CmmLit (CmmInt Integer
    n Width
    _))] | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8, Integer
    0 Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    n, Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    8 -> do
          (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          return $ Any (intFormat w) (\Reg
    dst -> OrdList Instr
    code_x OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Operand -> Instr
    SBFX (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    n)) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger (Integer
    8Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    n))))
                                                     OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` (Operand -> Operand -> Instr
    UXTB (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst))) -- See Note [Signed arithmetic on AArch64]
        CmmMachOp (MO_S_Shr Width
    w) [CmmExpr
    x, CmmExpr
    y] | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8 -> do
          (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) (\Reg
    dst -> OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Instr
    SXTB (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x)) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                                                             (Operand -> Operand -> Operand -> Instr
    ASR (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y)) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                                                             (Operand -> Operand -> Instr
    UXTB (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst))) -- See Note [Signed arithmetic on AArch64]

        CmmMachOp (MO_S_Shr Width
    w) [CmmExpr
    x, (CmmLit (CmmInt Integer
    n Width
    _))] | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W16, Integer
    0 Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    n, Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    16 -> do
          (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          return $ Any (intFormat w) (\Reg
    dst -> OrdList Instr
    code_x OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Operand -> Instr
    SBFX (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    n)) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger (Integer
    16Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    n))))
                                                     OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` (Operand -> Operand -> Instr
    UXTH (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst))) -- See Note [Signed arithmetic on AArch64]
        CmmMachOp (MO_S_Shr Width
    w) [CmmExpr
    x, CmmExpr
    y] | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W16 -> do
          (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) (\Reg
    dst -> OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Instr
    SXTH (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x)) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                                                             (Operand -> Operand -> Operand -> Instr
    ASR (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y)) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                                                             (Operand -> Operand -> Instr
    UXTH (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst))) -- See Note [Signed arithmetic on AArch64]

        CmmMachOp (MO_S_Shr Width
    w) [CmmExpr
    x, (CmmLit (CmmInt Integer
    n Width
    _))]
          | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W32 Bool -> Bool -> Bool
    || Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64
          , Integer
    0 Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    n, Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Width -> Int
    widthInBits Width
    w) -> do
          (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          return $ Any (intFormat w) (\Reg
    dst -> OrdList Instr
    code_x OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    ASR (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    n))))

        CmmMachOp (MO_U_Shr Width
    w) [CmmExpr
    x, (CmmLit (CmmInt Integer
    n Width
    _))] | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8, Integer
    0 Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    n, Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    8 -> do
          (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          return $ Any (intFormat w) (\Reg
    dst -> OrdList Instr
    code_x OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Operand -> Instr
    UBFX (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    n)) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger (Integer
    8Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    n)))))
        CmmMachOp (MO_U_Shr Width
    w) [CmmExpr
    x, CmmExpr
    y] | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8 -> do
          (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) (\Reg
    dst -> OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Instr
    UXTB (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x)) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                                                            (Operand -> Operand -> Operand -> Instr
    ASR (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y)))

        CmmMachOp (MO_U_Shr Width
    w) [CmmExpr
    x, (CmmLit (CmmInt Integer
    n Width
    _))] | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W16, Integer
    0 Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    n, Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    16 -> do
          (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          return $ Any (intFormat w) (\Reg
    dst -> OrdList Instr
    code_x OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Operand -> Instr
    UBFX (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    n)) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger (Integer
    16Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    n)))))
        CmmMachOp (MO_U_Shr Width
    w) [CmmExpr
    x, CmmExpr
    y] | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W16 -> do
          (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) (\Reg
    dst -> OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Instr
    UXTH (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x))
                                                                    OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` (Operand -> Operand -> Operand -> Instr
    ASR (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y)))

        CmmMachOp (MO_U_Shr Width
    w) [CmmExpr
    x, (CmmLit (CmmInt Integer
    n Width
    _))]
          | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W32 Bool -> Bool -> Bool
    || Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64
          , Integer
    0 Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    n, Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Width -> Int
    widthInBits Width
    w) -> do
          (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          return $ Any (intFormat w) (\Reg
    dst -> OrdList Instr
    code_x OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    LSR (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    n))))

        -- 3. Logic &&, ||
        CmmMachOp (MO_And Width
    w) [(CmmReg CmmReg
    reg), CmmLit (CmmInt Integer
    n Width
    _)] | Width -> Integer -> Bool
    isAArch64Bitmask (Width -> Width
    opRegWidth Width
    w') (Integer -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    n) ->
          Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    w) (\Reg
    d -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    AND (Width -> Reg -> Operand
    OpReg Width
    w Reg
    d) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    n))))
          where w' :: Width
    w' = Format -> Width
    formatToWidth (CmmType -> Format
    cmmTypeFormat (CmmReg -> CmmType
    cmmRegType CmmReg
    reg))
                r' :: Reg
    r' = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    plat CmmReg
    reg

        CmmMachOp (MO_Or Width
    w) [(CmmReg CmmReg
    reg), CmmLit (CmmInt Integer
    n Width
    _)] | Width -> Integer -> Bool
    isAArch64Bitmask (Width -> Width
    opRegWidth Width
    w') (Integer -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    n) ->
          Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    w) (\Reg
    d -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    ORR (Width -> Reg -> Operand
    OpReg Width
    w Reg
    d) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    n))))
          where w' :: Width
    w' = Format -> Width
    formatToWidth (CmmType -> Format
    cmmTypeFormat (CmmReg -> CmmType
    cmmRegType CmmReg
    reg))
                r' :: Reg
    r' = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    plat CmmReg
    reg

        -- Generic binary case.
        CmmMachOp MachOp
    op [CmmExpr
    x, CmmExpr
    y] -> do
          -- alright, so we have an operation, and two expressions. And we want to essentially do
          -- ensure we get float regs (TODO(Ben): What?)
          let withTempIntReg :: Width -> (Operand -> NatM b) -> NatM b
    withTempIntReg Width
    w Operand -> NatM b
    op = Width -> Reg -> Operand
    OpReg Width
    w (Reg -> Operand) -> NatM Reg -> NatM Operand
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Format -> NatM Reg
    getNewRegNat (Width -> Format
    intFormat Width
    w) NatM Operand -> (Operand -> NatM b) -> NatM b
    forall a b. NatM a -> (a -> NatM b) -> NatM b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Operand -> NatM b
    op
              -- withTempFloatReg w op = OpReg w <$> getNewRegNat (floatFormat w) >>= op

              -- A "plain" operation.
              bitOpImm :: Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> (Integer -> Width -> Maybe Operand)
    -> NatM Register
    bitOpImm Width
    w Operand -> Operand -> Operand -> OrdList Instr
    op Integer -> Width -> Maybe Operand
    encode_imm = do
                -- compute x<m> <- x
                -- compute x<o> <- y
                -- <OP> x<n>, x<m>, x<o>
                (reg_x, format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
                (op_y, format_y, code_y) <- case y of
                  CmmLit (CmmInt Integer
    n Width
    w)
                    | Just Operand
    imm_operand_y <- Integer -> Width -> Maybe Operand
    encode_imm Integer
    n Width
    w
                    -> (Operand, Format, OrdList Instr)
    -> NatM (Operand, Format, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Operand
    imm_operand_y, Width -> Format
    intFormat Width
    w, OrdList Instr
    forall a. OrdList a
    nilOL)
                  CmmExpr
    _ -> do
                      (reg_y, format_y, code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    y
                      return (OpReg w reg_y, format_y, code_y)
                massertPpr (isIntFormat format_x == isIntFormat format_y) $ text "bitOpImm: incompatible"
                return $ Any (intFormat w) (\Reg
    dst ->
                    OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    OrdList Instr
    code_y OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    Operand -> Operand -> Operand -> OrdList Instr
    op (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) Operand
    op_y)

              -- A (potentially signed) integer operation.
              -- In the case of 8- and 16-bit signed arithmetic we must first
              -- sign-extend both arguments to 32-bits.
              -- See Note [Signed arithmetic on AArch64].
              intOpImm :: Bool -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Width -> Maybe Operand) -> NatM (Register)
              intOpImm :: Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> (Integer -> Width -> Maybe Operand)
    -> NatM Register
    intOpImm {- is signed -} Bool
    True  Width
    w Operand -> Operand -> Operand -> OrdList Instr
    op Integer -> Width -> Maybe Operand
    _encode_imm = Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    intOp Bool
    True Width
    w Operand -> Operand -> Operand -> OrdList Instr
    op
              intOpImm                 Bool
    False Width
    w Operand -> Operand -> Operand -> OrdList Instr
    op  Integer -> Width -> Maybe Operand
    encode_imm = do
                  -- compute x<m> <- x
                  -- compute x<o> <- y
                  -- <OP> x<n>, x<m>, x<o>
                  (reg_x, format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
                  (op_y, format_y, code_y) <- case y of
                    CmmLit (CmmInt Integer
    n Width
    w)
                      | Just Operand
    imm_operand_y <- Integer -> Width -> Maybe Operand
    encode_imm Integer
    n Width
    w
                      -> (Operand, Format, OrdList Instr)
    -> NatM (Operand, Format, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Operand
    imm_operand_y, Width -> Format
    intFormat Width
    w, OrdList Instr
    forall a. OrdList a
    nilOL)
                    CmmExpr
    _ -> do
                        (reg_y, format_y, code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    y
                        return (OpReg w reg_y, format_y, code_y)
                  massertPpr (isIntFormat format_x && isIntFormat format_y) $ text "intOp: non-int"
                  -- This is the width of the registers on which the operation
                  -- should be performed.
                  let w' = Width -> Width
    opRegWidth Width
    w
                  return $ Any (intFormat w) $ \Reg
    dst ->
                      OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                      OrdList Instr
    code_y OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                      Operand -> Operand -> Operand -> OrdList Instr
    op (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    reg_x) (Operand
    op_y) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                      Width -> Width -> Reg -> OrdList Instr
    truncateReg Width
    w' Width
    w Reg
    dst -- truncate back to the operand's original width

              -- A (potentially signed) integer operation.
              -- In the case of 8- and 16-bit signed arithmetic we must first
              -- sign-extend both arguments to 32-bits.
              -- See Note [Signed arithmetic on AArch64].
              intOp :: Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    intOp Bool
    is_signed Width
    w Operand -> Operand -> Operand -> OrdList Instr
    op = do
                  -- compute x<m> <- x
                  -- compute x<o> <- y
                  -- <OP> x<n>, x<m>, x<o>
                  (reg_x, format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
                  (reg_y, format_y, code_y) <- getSomeReg y
                  massertPpr (isIntFormat format_x && isIntFormat format_y) $ text "intOp: non-int"
                  -- This is the width of the registers on which the operation
                  -- should be performed.
                  let w' = Width -> Width
    opRegWidth Width
    w
                      signExt Reg
    r
                        | Bool -> Bool
    not Bool
    is_signed  = (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    r, OrdList Instr
    forall a. OrdList a
    nilOL)
                        | Bool
    otherwise      = Width -> Width -> Reg -> NatM (Reg, OrdList Instr)
    signExtendReg Width
    w Width
    w' Reg
    r
                  (reg_x_sx, code_x_sx) <- signExt reg_x
                  (reg_y_sx, code_y_sx) <- signExt reg_y
                  return $ Any (intFormat w) $ \Reg
    dst ->
                      OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                      OrdList Instr
    code_y OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                      -- sign-extend both operands
                      OrdList Instr
    code_x_sx OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                      OrdList Instr
    code_y_sx OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                      Operand -> Operand -> Operand -> OrdList Instr
    op (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    reg_x_sx) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    reg_y_sx) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                      Width -> Width -> Reg -> OrdList Instr
    truncateReg Width
    w' Width
    w Reg
    dst -- truncate back to the operand's original width

              floatOp :: Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    floatOp Width
    w Operand -> Operand -> Operand -> OrdList Instr
    op = do
                (reg_fx, format_x, code_fx) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
    CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getFloatReg CmmExpr
    x
                (reg_fy, format_y, code_fy) <- getFloatReg y
                massertPpr (isFloatFormat format_x && isFloatFormat format_y) $ text "floatOp: non-float"
                return $ Any (floatFormat w) (\Reg
    dst -> OrdList Instr
    code_fx OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_fy OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Operand -> Operand -> Operand -> OrdList Instr
    op (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_fx) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_fy))

              -- need a special one for conditionals, as they return ints
              floatCond :: Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    floatCond Width
    w Operand -> Operand -> Operand -> OrdList Instr
    op = do
                (reg_fx, format_x, code_fx) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
    CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getFloatReg CmmExpr
    x
                (reg_fy, format_y, code_fy) <- getFloatReg y
                massertPpr (isFloatFormat format_x && isFloatFormat format_y) $ text "floatCond: non-float"
                return $ Any (intFormat w) (\Reg
    dst -> OrdList Instr
    code_fx OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_fy OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Operand -> Operand -> Operand -> OrdList Instr
    op (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_fx) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_fy))

          case MachOp
    op of
            -- Integer operations
            -- Add/Sub should only be Integer Options.
            MO_Add Width
    w -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> (Integer -> Width -> Maybe Operand)
    -> NatM Register
    intOpImm Bool
    False Width
    w (\Operand
    d Operand
    x Operand
    y -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    ADD Operand
    d Operand
    x Operand
    y)) Integer -> Width -> Maybe Operand
    getArithImm
            -- TODO: Handle sub-word case
            MO_Sub Width
    w -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> (Integer -> Width -> Maybe Operand)
    -> NatM Register
    intOpImm Bool
    False Width
    w (\Operand
    d Operand
    x Operand
    y -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    SUB Operand
    d Operand
    x Operand
    y)) Integer -> Width -> Maybe Operand
    getArithImm

            -- Note [CSET]
            -- ~~~~~~~~~~~
            -- Setting conditional flags: the architecture internally knows the
            -- following flag bits.  And based on thsoe comparisons as in the
            -- table below.
            --
            --    31  30  29  28
            --  .---+---+---+---+-- - -
            --  | N | Z | C | V |
            --  '---+---+---+---+-- - -
            --  Negative
            --  Zero
            --  Carry
            --  oVerflow
            --
            --  .------+-------------------------------------+-----------------+----------.
            --  | Code | Meaning                             | Flags           | Encoding |
            --  |------+-------------------------------------+-----------------+----------|
            --  |  EQ  | Equal                               | Z = 1           | 0000     |
            --  |  NE  | Not Equal                           | Z = 0           | 0001     |
            --  |  HI  | Unsigned Higher                     | C = 1 && Z = 0  | 1000     |
            --  |  HS  | Unsigned Higher or Same             | C = 1           | 0010     |
            --  |  LS  | Unsigned Lower or Same              | C = 0 || Z = 1  | 1001     |
            --  |  LO  | Unsigned Lower                      | C = 0           | 0011     |
            --  |  GT  | Signed Greater Than                 | Z = 0 && N = V  | 1100     |
            --  |  GE  | Signed Greater Than or Equal        | N = V           | 1010     |
            --  |  LE  | Signed Less Than or Equal           | Z = 1 || N /= V | 1101     |
            --  |  LT  | Signed Less Than                    | N /= V          | 1011     |
            --  |  CS  | Carry Set (Unsigned Overflow)       | C = 1           | 0010     |
            --  |  CC  | Carry Clear (No Unsigned Overflow)  | C = 0           | 0011     |
            --  |  VS  | Signed Overflow                     | V = 1           | 0110     |
            --  |  VC  | No Signed Overflow                  | V = 0           | 0111     |
            --  |  MI  | Minus, Negative                     | N = 1           | 0100     |
            --  |  PL  | Plus, Positive or Zero (!)          | N = 0           | 0101     |
            --  |  AL  | Always                              | Any             | 1110     |
            --  |  NV  | Never                               | Any             | 1111     |
            --- '-------------------------------------------------------------------------'

            -- N.B. We needn't sign-extend sub-word size (in)equality comparisons
            -- since we don't care about ordering.
            MO_Eq Width
    w     -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> (Integer -> Width -> Maybe Operand)
    -> NatM Register
    bitOpImm Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    EQ ]) Integer -> Width -> Maybe Operand
    getArithImm
            MO_Ne Width
    w     -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> (Integer -> Width -> Maybe Operand)
    -> NatM Register
    bitOpImm Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    NE ]) Integer -> Width -> Maybe Operand
    getArithImm

            -- Signed multiply/divide
            MO_Mul Width
    w          -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    intOp Bool
    True Width
    w (\Operand
    d Operand
    x Operand
    y -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Operand -> Instr
    MUL Operand
    d Operand
    x Operand
    y)
            MO_S_MulMayOflo Width
    w -> Width -> CmmExpr -> CmmExpr -> NatM Register
    do_mul_may_oflo Width
    w CmmExpr
    x CmmExpr
    y
            MO_S_Quot Width
    w       -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    intOp Bool
    True Width
    w (\Operand
    d Operand
    x Operand
    y -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Operand -> Instr
    SDIV Operand
    d Operand
    x Operand
    y)

            -- No native rem instruction. So we'll compute the following
            -- Rd  <- Rx / Ry             | 2 <- 7 / 3      -- SDIV Rd Rx Ry
            -- Rd' <- Rx - Rd * Ry        | 1 <- 7 - 2 * 3  -- MSUB Rd' Rd Ry Rx
            --        |     '---|----------------|---'   |
            --        |         '----------------|-------'
            --        '--------------------------'
            -- Note the swap in Rx and Ry.
            MO_S_Rem Width
    w -> Width -> (Operand -> NatM Register) -> NatM Register
    forall {b}. Width -> (Operand -> NatM b) -> NatM b
    withTempIntReg Width
    w ((Operand -> NatM Register) -> NatM Register)
    -> (Operand -> NatM Register) -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ \Operand
    t ->
                          Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    intOp Bool
    True Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Operand -> Instr
    SDIV Operand
    t Operand
    x Operand
    y, Operand -> Operand -> Operand -> Operand -> Instr
    MSUB Operand
    d Operand
    t Operand
    y Operand
    x ])

            -- Unsigned multiply/divide
            MO_U_Quot Width
    w -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    intOp Bool
    False Width
    w (\Operand
    d Operand
    x Operand
    y -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Operand -> Instr
    UDIV Operand
    d Operand
    x Operand
    y)
            MO_U_Rem Width
    w  -> Width -> (Operand -> NatM Register) -> NatM Register
    forall {b}. Width -> (Operand -> NatM b) -> NatM b
    withTempIntReg Width
    w ((Operand -> NatM Register) -> NatM Register)
    -> (Operand -> NatM Register) -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ \Operand
    t ->
                           Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    intOp Bool
    False Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Operand -> Instr
    UDIV Operand
    t Operand
    x Operand
    y, Operand -> Operand -> Operand -> Operand -> Instr
    MSUB Operand
    d Operand
    t Operand
    y Operand
    x ])

            -- Signed comparisons -- see Note [CSET]
            MO_S_Ge Width
    w     -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    intOp Bool
    True  Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    SGE ])
            MO_S_Le Width
    w     -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    intOp Bool
    True  Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    SLE ])
            MO_S_Gt Width
    w     -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    intOp Bool
    True  Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    SGT ])
            MO_S_Lt Width
    w     -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    intOp Bool
    True  Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    SLT ])

            -- Unsigned comparisons
            MO_U_Ge Width
    w     -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> (Integer -> Width -> Maybe Operand)
    -> NatM Register
    intOpImm Bool
    False Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    UGE ]) Integer -> Width -> Maybe Operand
    getArithImm
            MO_U_Le Width
    w     -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> (Integer -> Width -> Maybe Operand)
    -> NatM Register
    intOpImm Bool
    False Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    ULE ]) Integer -> Width -> Maybe Operand
    getArithImm
            MO_U_Gt Width
    w     -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> (Integer -> Width -> Maybe Operand)
    -> NatM Register
    intOpImm Bool
    False Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    UGT ]) Integer -> Width -> Maybe Operand
    getArithImm
            MO_U_Lt Width
    w     -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> (Integer -> Width -> Maybe Operand)
    -> NatM Register
    intOpImm Bool
    False Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    ULT ]) Integer -> Width -> Maybe Operand
    getArithImm

            -- Floating point arithmetic
            MO_F_Add Width
    w   -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    floatOp Width
    w (\Operand
    d Operand
    x Operand
    y -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Operand -> Instr
    ADD Operand
    d Operand
    x Operand
    y)
            MO_F_Sub Width
    w   -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    floatOp Width
    w (\Operand
    d Operand
    x Operand
    y -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Operand -> Instr
    SUB Operand
    d Operand
    x Operand
    y)
            MO_F_Mul Width
    w   -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    floatOp Width
    w (\Operand
    d Operand
    x Operand
    y -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Operand -> Instr
    MUL Operand
    d Operand
    x Operand
    y)
            MO_F_Quot Width
    w  -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    floatOp Width
    w (\Operand
    d Operand
    x Operand
    y -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Operand -> Instr
    SDIV Operand
    d Operand
    x Operand
    y)

            -- Floating point comparison
            MO_F_Eq Width
    w    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    floatCond Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    EQ ])
            MO_F_Ne Width
    w    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    floatCond Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    NE ])

            -- careful with the floating point operations.
            -- SLE is effectively LE or unordered (NaN)
            -- SLT is the same. ULE, and ULT will not return true for NaN.
            -- This is a bit counter-intuitive. Don't let yourself be fooled by
            -- the S/U prefix for floats, it's only meaningful for integers.
            MO_F_Ge Width
    w    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    floatCond Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    OGE ])
            MO_F_Le Width
    w    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    floatCond Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    OLE ]) -- x <= y <=> y > x
            MO_F_Gt Width
    w    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    floatCond Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    OGT ])
            MO_F_Lt Width
    w    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    floatCond Width
    w (\Operand
    d Operand
    x Operand
    y -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    OLT ]) -- x < y <=> y >= x

            -- Bitwise operations
            MO_And   Width
    w -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> (Integer -> Width -> Maybe Operand)
    -> NatM Register
    bitOpImm Width
    w (\Operand
    d Operand
    x Operand
    y -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Operand -> Instr
    AND Operand
    d Operand
    x Operand
    y) Integer -> Width -> Maybe Operand
    getBitmaskImm
            MO_Or    Width
    w -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> (Integer -> Width -> Maybe Operand)
    -> NatM Register
    bitOpImm Width
    w (\Operand
    d Operand
    x Operand
    y -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Operand -> Instr
    ORR Operand
    d Operand
    x Operand
    y) Integer -> Width -> Maybe Operand
    getBitmaskImm
            MO_Xor   Width
    w -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> (Integer -> Width -> Maybe Operand)
    -> NatM Register
    bitOpImm Width
    w (\Operand
    d Operand
    x Operand
    y -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Operand -> Instr
    EOR Operand
    d Operand
    x Operand
    y) Integer -> Width -> Maybe Operand
    getBitmaskImm
            MO_Shl   Width
    w -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    intOp Bool
    False Width
    w (\Operand
    d Operand
    x Operand
    y -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Operand -> Instr
    LSL Operand
    d Operand
    x Operand
    y)
            MO_U_Shr Width
    w -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    intOp Bool
    False Width
    w (\Operand
    d Operand
    x Operand
    y -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Operand -> Instr
    LSR Operand
    d Operand
    x Operand
    y)
            MO_S_Shr Width
    w -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    intOp Bool
    True  Width
    w (\Operand
    d Operand
    x Operand
    y -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Operand -> Instr
    ASR Operand
    d Operand
    x Operand
    y)

            -- TODO

            MachOp
    op -> String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister' (unhandled dyadic CmmMachOp): " (SDoc -> NatM Register) -> SDoc -> NatM Register
    forall a b. (a -> b) -> a -> b
    $
                    (MachOp -> SDoc
    pprMachOp MachOp
    op) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "in" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)

        -- Generic ternary case.
        CmmMachOp MachOp
    op [CmmExpr
    x, CmmExpr
    y, CmmExpr
    z] ->

          case MachOp
    op of

            -- Floating-point fused multiply-add operations

            -- x86 fmadd    x * y + z <=> AArch64 fmadd : d =   r1 * r2 + r3
            -- x86 fmsub    x * y - z <=> AArch64 fnmsub: d =   r1 * r2 - r3
            -- x86 fnmadd - x * y + z <=> AArch64 fmsub : d = - r1 * r2 + r3
            -- x86 fnmsub - x * y - z <=> AArch64 fnmadd: d = - r1 * r2 - r3

            MO_FMA FMASign
    var Width
    w -> case FMASign
    var of
              FMASign
    FMAdd  -> Width
    -> (Operand -> Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    float3Op Width
    w (\Operand
    d Operand
    n Operand
    m Operand
    a -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ FMASign -> Operand -> Operand -> Operand -> Operand -> Instr
    FMA FMASign
    FMAdd  Operand
    d Operand
    n Operand
    m Operand
    a)
              FMASign
    FMSub  -> Width
    -> (Operand -> Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    float3Op Width
    w (\Operand
    d Operand
    n Operand
    m Operand
    a -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ FMASign -> Operand -> Operand -> Operand -> Operand -> Instr
    FMA FMASign
    FNMSub Operand
    d Operand
    n Operand
    m Operand
    a)
              FMASign
    FNMAdd -> Width
    -> (Operand -> Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    float3Op Width
    w (\Operand
    d Operand
    n Operand
    m Operand
    a -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ FMASign -> Operand -> Operand -> Operand -> Operand -> Instr
    FMA FMASign
    FMSub  Operand
    d Operand
    n Operand
    m Operand
    a)
              FMASign
    FNMSub -> Width
    -> (Operand -> Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    float3Op Width
    w (\Operand
    d Operand
    n Operand
    m Operand
    a -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ FMASign -> Operand -> Operand -> Operand -> Operand -> Instr
    FMA FMASign
    FNMAdd Operand
    d Operand
    n Operand
    m Operand
    a)

            MachOp
    _ -> String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister' (unhandled ternary CmmMachOp): " (SDoc -> NatM Register) -> SDoc -> NatM Register
    forall a b. (a -> b) -> a -> b
    $
                    (MachOp -> SDoc
    pprMachOp MachOp
    op) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "in" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)

          where
              float3Op :: Width
    -> (Operand -> Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    float3Op Width
    w Operand -> Operand -> Operand -> Operand -> OrdList Instr
    op = do
                (reg_fx, format_x, code_fx) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
    CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getFloatReg CmmExpr
    x
                (reg_fy, format_y, code_fy) <- getFloatReg y
                (reg_fz, format_z, code_fz) <- getFloatReg z
                massertPpr (isFloatFormat format_x && isFloatFormat format_y && isFloatFormat format_z) $
                  text "float3Op: non-float"
                return $
                  Any (floatFormat w) $ \ Reg
    dst ->
                    OrdList Instr
    code_fx OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    OrdList Instr
    code_fy OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    OrdList Instr
    code_fz OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    Operand -> Operand -> Operand -> Operand -> OrdList Instr
    op (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_fx) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_fy) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_fz)

        CmmMachOp MachOp
    _op [CmmExpr]
    _xs
          -> String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister' (variadic CmmMachOp): " (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)

      where
        isNbitEncodeable :: Int -> Integer -> Bool
        isNbitEncodeable :: Int -> Integer -> Bool
    isNbitEncodeable Int
    n_bits Integer
    i = let shift :: Int
    shift = Int
    n_bits Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 in (-Integer
    1 Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    shift) Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    i Bool -> Bool -> Bool
    && Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < (Integer
    1 Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    shift)

        -- N.B. MUL does not set the overflow flag.
        -- These implementations are based on output from GCC 11.
        do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
        do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
    do_mul_may_oflo w :: Width
    w@Width
    W64 CmmExpr
    x CmmExpr
    y = do
            (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
            (reg_y, _format_y, code_y) <- getSomeReg y
            lo <- getNewRegNat II64
            hi <- getNewRegNat II64
            return $ Any (intFormat w) (\Reg
    dst ->
                OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                OrdList Instr
    code_y OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                Operand -> Operand -> Operand -> Instr
    MUL (Width -> Reg -> Operand
    OpReg Width
    w Reg
    lo) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                Operand -> Operand -> Operand -> Instr
    SMULH (Width -> Reg -> Operand
    OpReg Width
    w Reg
    hi) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                Operand -> Operand -> Instr
    CMP (Width -> Reg -> Operand
    OpReg Width
    w Reg
    hi) (Width -> Reg -> ShiftMode -> Int -> Operand
    OpRegShift Width
    w Reg
    lo ShiftMode
    SASR Int
    63) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                Operand -> Cond -> Instr
    CSET (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) Cond
    NE)

        do_mul_may_oflo Width
    W32 CmmExpr
    x CmmExpr
    y = do
            (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
            (reg_y, _format_y, code_y) <- getSomeReg y
            tmp1 <- getNewRegNat II64
            tmp2 <- getNewRegNat II64
            return $ Any (intFormat W32) (\Reg
    dst ->
                OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                OrdList Instr
    code_y OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                Operand -> Operand -> Operand -> Instr
    SMULL (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    tmp1) (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    reg_y) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                Operand -> Operand -> Operand -> Instr
    ASR (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    tmp2) (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    tmp1) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    31)) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                Operand -> Operand -> Instr
    CMP (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    tmp2) (Width -> Reg -> ShiftMode -> Int -> Operand
    OpRegShift Width
    W32 Reg
    tmp1 ShiftMode
    SASR Int
    31) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                Operand -> Cond -> Instr
    CSET (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    dst) Cond
    NE)

        do_mul_may_oflo Width
    w CmmExpr
    x CmmExpr
    y = do
            (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
            (reg_y, _format_y, code_y) <- getSomeReg y
            tmp1 <- getNewRegNat II32
            tmp2 <- getNewRegNat II32
            let extend Reg
    dst Reg
    arg =
                  case Width
    w of
                    Width
    W16 -> Operand -> Operand -> Instr
    SXTH (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    arg)
                    Width
    W8  -> Operand -> Operand -> Instr
    SXTB (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    arg)
                    Width
    _   -> String -> Instr
    forall a. HasCallStack => String -> a
    panic String
    "unreachable"
                cmp_ext_mode =
                  case Width
    w of
                    Width
    W16 -> ExtMode
    EUXTH
                    Width
    W8  -> ExtMode
    EUXTB
                    Width
    _   -> String -> ExtMode
    forall a. HasCallStack => String -> a
    panic String
    "unreachable"
                width = Width -> Int
    widthInBits Width
    w
                opInt = Imm -> Operand
    OpImm (Imm -> Operand) -> (Int -> Imm) -> Int -> Operand
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Imm
    ImmInt

            return $ Any (intFormat w) (\Reg
    dst ->
                OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                OrdList Instr
    code_y OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                Reg -> Reg -> Instr
    extend Reg
    tmp1 Reg
    reg_x OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                Reg -> Reg -> Instr
    extend Reg
    tmp2 Reg
    reg_y OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                Operand -> Operand -> Operand -> Instr
    MUL (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    tmp1) (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    tmp1) (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    tmp2) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                Operand -> Operand -> Operand -> Operand -> Instr
    SBFX (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    tmp2) (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    tmp1) (Int -> Operand
    opInt (Int -> Operand) -> Int -> Operand
    forall a b. (a -> b) -> a -> b
    $ Int
    width Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) (Int -> Operand
    opInt Int
    1) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                Operand -> Operand -> Operand -> Operand -> Instr
    UBFX (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    tmp1) (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    tmp1) (Int -> Operand
    opInt Int
    width) (Int -> Operand
    opInt Int
    width) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                Operand -> Operand -> Instr
    CMP (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    tmp1) (Width -> Reg -> ExtMode -> Int -> Operand
    OpRegExt Width
    W32 Reg
    tmp2 ExtMode
    cmp_ext_mode Int
    0) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                Operand -> Cond -> Instr
    CSET (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) Cond
    NE)

    -- | Is a given number encodable as a bitmask immediate?
    --
    -- https://stackoverflow.com/questions/30904718/range-of-immediate-values-in-armv8-a64-assembly
    isAArch64Bitmask :: Width -> Integer -> Bool
    -- N.B. zero and ~0 are not encodable as bitmask immediates
    isAArch64Bitmask :: Width -> Integer -> Bool
    isAArch64Bitmask Width
    width Integer
    n =
      Bool -> Bool -> Bool
    forall a. HasCallStack => Bool -> a -> a
    assert (Width
    width Width -> [Width] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Width
    W32,Width
    W64]) (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $
      case Integer
    n of
        Integer
    0 -> Bool
    False
        Integer
    _ | Integer
    n Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int -> Integer
    forall a. Bits a => Int -> a
    bit (Width -> Int
    widthInBits Width
    width) Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    1
          -> Bool
    False -- 1111...1111
          | Bool
    otherwise
          -> (Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 Bool -> Bool -> Bool
    && Int -> Bool
    check Int
    64) Bool -> Bool -> Bool
    || Int -> Bool
    check Int
    32 Bool -> Bool -> Bool
    || Int -> Bool
    check Int
    16 Bool -> Bool -> Bool
    || Int -> Bool
    check Int
    8
      where
        -- Check whether @n@ can be represented as a subpattern of the given
        -- width.
        check :: Int -> Bool
    check Int
    width
          | Word64 -> Bool
    hasOneRun Word64
    subpat =
              let n' :: Integer
    n' = Word64 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word64 -> Word64
    mkPat Int
    width Word64
    subpat)
              in Integer
    n Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    n'
          | Bool
    otherwise = Bool
    False
          where
            subpat :: Word64
            subpat :: Word64
    subpat = Integer -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer
    n Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    .&. (Int -> Integer
    forall a. Bits a => Int -> a
    bit Int
    width Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    1))

        -- Construct a bit-pattern from a repeated subpatterns the given width.
        mkPat :: Int -> Word64 -> Word64
        mkPat :: Int -> Word64 -> Word64
    mkPat Int
    width Word64
    subpat =
            (Word64 -> Word64 -> Word64) -> Word64 -> [Word64] -> Word64
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    (.|.) Word64
    0 [ Word64
    subpat Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    p | Int
    p <- [Int
    0, Int
    width..Int
    63] ]

        -- Does the given number's bit representation match the regular expression
        -- @0*1*0*@?
        hasOneRun :: Word64 -> Bool
        hasOneRun :: Word64 -> Bool
    hasOneRun Word64
    m =
            Int
    64 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word64 -> Int
    forall a. Bits a => a -> Int
    popCount Word64
    m Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Word64 -> Int
    forall b. FiniteBits b => b -> Int
    countLeadingZeros Word64
    m Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Word64 -> Int
    forall b. FiniteBits b => b -> Int
    countTrailingZeros Word64
    m

    -- | Instructions to sign-extend the value in the given register from width @w@
    -- up to width @w'@.
    signExtendReg :: Width -> Width -> Reg -> NatM (Reg, OrdList Instr)
    signExtendReg :: Width -> Width -> Reg -> NatM (Reg, OrdList Instr)
    signExtendReg Width
    w Width
    w' Reg
    r =
        case Width
    w of
          Width
    W64 -> NatM (Reg, OrdList Instr)
    noop
          Width
    W32
            | Width
    w' Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W32 -> NatM (Reg, OrdList Instr)
    noop
            | Bool
    otherwise -> (Operand -> Operand -> Instr) -> NatM (Reg, OrdList Instr)
    extend Operand -> Operand -> Instr
    SXTH
          Width
    W16           -> (Operand -> Operand -> Instr) -> NatM (Reg, OrdList Instr)
    extend Operand -> Operand -> Instr
    SXTH
          Width
    W8            -> (Operand -> Operand -> Instr) -> NatM (Reg, OrdList Instr)
    extend Operand -> Operand -> Instr
    SXTB
          Width
    _             -> String -> NatM (Reg, OrdList Instr)
    forall a. HasCallStack => String -> a
    panic String
    "intOp"
      where
        noop :: NatM (Reg, OrdList Instr)
    noop = (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    r, OrdList Instr
    forall a. OrdList a
    nilOL)
        extend :: (Operand -> Operand -> Instr) -> NatM (Reg, OrdList Instr)
    extend Operand -> Operand -> Instr
    instr = do
            r' <- Format -> NatM Reg
    getNewRegNat Format
    II64
            return (r', unitOL $ instr (OpReg w' r') (OpReg w' r))

    -- | Instructions to truncate the value in the given register from width @w@
    -- down to width @w'@.
    truncateReg :: Width -> Width -> Reg -> OrdList Instr
    truncateReg :: Width -> Width -> Reg -> OrdList Instr
    truncateReg Width
    w Width
    w' Reg
    r =
        case Width
    w of
          Width
    W64 -> OrdList Instr
    forall a. OrdList a
    nilOL
          Width
    W32
            | Width
    w' Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W32 -> OrdList Instr
    forall a. OrdList a
    nilOL
          Width
    _   -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Operand -> Operand -> Instr
    UBFM (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r)
                               (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r)
                               (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    0))
                               (Imm -> Operand
    OpImm (Imm -> Operand) -> Imm -> Operand
    forall a b. (a -> b) -> a -> b
    $ Int -> Imm
    ImmInt (Int -> Imm) -> Int -> Imm
    forall a b. (a -> b) -> a -> b
    $ Width -> Int
    widthInBits Width
    w' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)

    -- -----------------------------------------------------------------------------
    --  The 'Amode' type: Memory addressing modes passed up the tree.
    data Amode = Amode AddrMode InstrBlock

    getAmode :: Platform
             -> Width     -- ^ width of loaded value
             -> CmmExpr
             -> NatM Amode
    -- TODO: Specialize stuff we can destructure here.

    -- OPTIMIZATION WARNING: Addressing modes.
    -- Addressing options:
    getAmode :: Platform -> Width -> CmmExpr -> NatM Amode
    getAmode Platform
    platform Width
    w (CmmRegOff CmmReg
    reg Int
    off)
      | Int -> Width -> Bool
    isOffsetImm Int
    off Width
    w
      = Amode -> NatM Amode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Amode -> NatM Amode) -> Amode -> NatM Amode
    forall a b. (a -> b) -> a -> b
    $ AddrMode -> OrdList Instr -> Amode
    Amode (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    reg' Imm
    off') OrdList Instr
    forall a. OrdList a
    nilOL
        where reg' :: Reg
    reg' = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform CmmReg
    reg
              off' :: Imm
    off' = Int -> Imm
    ImmInt Int
    off

    -- For Stores we often see something like this:
    -- CmmStore (CmmMachOp (MO_Add w) [CmmLoad expr, CmmLit (CmmInt n w')]) (expr2)
    -- E.g. a CmmStoreOff really. This can be translated to `str $expr2, [$expr, #n ]
    -- for `n` in range.
    getAmode Platform
    _platform Width
    w (CmmMachOp (MO_Add Width
    _w) [CmmExpr
    expr, CmmLit (CmmInt Integer
    off Width
    _w')])
      | Int -> Width -> Bool
    isOffsetImm (Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    off) Width
    w
      = do (reg, _format, code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr
           return $ Amode (AddrRegImm reg (ImmInteger off)) code

    getAmode Platform
    _platform Width
    w (CmmMachOp (MO_Sub Width
    _w) [CmmExpr
    expr, CmmLit (CmmInt Integer
    off Width
    _w')])
      | Int -> Width -> Bool
    isOffsetImm (Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Int) -> Integer -> Int
    forall a b. (a -> b) -> a -> b
    $ -Integer
    off) Width
    w
      = do (reg, _format, code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr
           return $ Amode (AddrRegImm reg (ImmInteger $ -off)) code

    -- Generic case
    getAmode Platform
    _platform Width
    _ CmmExpr
    expr
      = do (reg, _format, code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr
           return $ Amode (AddrReg reg) code

    -- -----------------------------------------------------------------------------
    -- Generating assignments

    -- Assignments are really at the heart of the whole code generation
    -- business.  Almost all top-level nodes of any real importance are
    -- assignments, which correspond to loads, stores, or register
    -- transfers.  If we're really lucky, some of the register transfers
    -- will go away, because we can use the destination register to
    -- complete the code generation for the right hand side.  This only
    -- fails when the right hand side is forced into a fixed register
    -- (e.g. the result of a call).

    assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
    assignReg_IntCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock

    assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
    assignReg_FltCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock

    assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_IntCode Format
    rep CmmExpr
    addrE CmmExpr
    srcE
      = do
        (src_reg, _format, code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    srcE
        platform <- getPlatform
        let w = Format -> Width
    formatToWidth Format
    rep
        Amode addr addr_code <- getAmode platform w addrE
        return $ COMMENT (text "CmmStore" <+> parens (text (show addrE)) <+> parens (text (show srcE)))
                `consOL` (code
                `appOL` addr_code
                `snocOL` STR rep (OpReg w src_reg) (OpAddr addr))

    assignReg_IntCode :: Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_IntCode Format
    _ CmmReg
    reg CmmExpr
    src
      = do
        platform <- NatM Platform
    getPlatform
        let dst = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform CmmReg
    reg
        r <- getRegister src
        return $ case r of
          Any Format
    _ Reg -> OrdList Instr
    code              -> SDoc -> Instr
    COMMENT (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "CmmAssign" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (CmmReg -> String
    forall a. Show a => a -> String
    show CmmReg
    reg)) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (CmmExpr -> String
    forall a. Show a => a -> String
    show CmmExpr
    src))) Instr -> OrdList Instr -> OrdList Instr
    forall a. a -> OrdList a -> OrdList a
    `consOL` Reg -> OrdList Instr
    code Reg
    dst
          Fixed Format
    format Reg
    freg OrdList Instr
    fcode -> SDoc -> Instr
    COMMENT (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "CmmAssign" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (CmmReg -> String
    forall a. Show a => a -> String
    show CmmReg
    reg)) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (CmmExpr -> String
    forall a. Show a => a -> String
    show CmmExpr
    src))) Instr -> OrdList Instr -> OrdList Instr
    forall a. a -> OrdList a -> OrdList a
    `consOL` (OrdList Instr
    fcode OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg (Format -> Width
    formatToWidth Format
    format) Reg
    dst) (Width -> Reg -> Operand
    OpReg (Format -> Width
    formatToWidth Format
    format) Reg
    freg))

    -- Let's treat Floating point stuff
    -- as integer code for now. Opaque.
    assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_FltCode = Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_IntCode
    assignReg_FltCode :: Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_FltCode = Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_IntCode

    -- -----------------------------------------------------------------------------
    -- Jumps

    genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock
    genJump :: CmmExpr -> NatM (OrdList Instr)
    genJump expr :: CmmExpr
    expr@(CmmLit (CmmLabel CLabel
    lbl)) = do
      cur_mod <- NatM Module
    getThisModuleNat
      !useFarJumps <- ncgEnableInterModuleFarJumps <$> getConfig
      let is_local = Module -> CLabel -> Bool
    isLocalCLabel Module
    cur_mod CLabel
    lbl

      -- We prefer to generate a near jump using a simble `B` instruction
      -- with a range (+/-128MB). But if the target is outside the current module
      -- we might have to account for large code offsets. (#24648)
      if not useFarJumps || is_local
        then return $ unitOL (annExpr expr (J (TLabel lbl)))
        else do
          (target, _format, code) <- getSomeReg expr
          return (code `appOL` unitOL (annExpr expr (J (TReg target))))

    genJump CmmExpr
    expr = do
        (target, _format, code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr
        return (code `appOL` unitOL (annExpr expr (J (TReg target))))

    -- -----------------------------------------------------------------------------
    --  Unconditional branches
    genBranch :: BlockId -> NatM InstrBlock
    genBranch :: BlockId -> NatM (OrdList Instr)
    genBranch = OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> (BlockId -> OrdList Instr) -> BlockId -> NatM (OrdList Instr)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL ([Instr] -> OrdList Instr)
    -> (BlockId -> [Instr]) -> BlockId -> OrdList Instr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BlockId -> [Instr]
    mkJumpInstr

    -- -----------------------------------------------------------------------------
    -- Conditional branches
    genCondJump
        :: BlockId
        -> CmmExpr
        -> NatM InstrBlock
    genCondJump :: BlockId -> CmmExpr -> NatM (OrdList Instr)
    genCondJump BlockId
    bid CmmExpr
    expr = do
        case CmmExpr
    expr of
          -- Optimized == 0 case.
          CmmMachOp (MO_Eq Width
    w) [CmmExpr
    x, CmmLit (CmmInt Integer
    0 Width
    _)] -> do
            (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
            return $ code_x `snocOL` (annExpr expr (CBZ (OpReg w reg_x) (TBlock bid)))

          -- Optimized /= 0 case.
          CmmMachOp (MO_Ne Width
    w) [CmmExpr
    x, CmmLit (CmmInt Integer
    0 Width
    _)] -> do
            (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
            return $ code_x `snocOL`  (annExpr expr (CBNZ (OpReg w reg_x) (TBlock bid)))

          -- Generic case.
          CmmMachOp MachOp
    mop [CmmExpr
    x, CmmExpr
    y] -> do

            let ubcond :: Width -> Cond -> NatM (OrdList Instr)
    ubcond Width
    w Cond
    cmp = do
                    -- compute both sides.
                    (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
                    (reg_y, _format_y, code_y) <- getSomeReg y
                    let x' = Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x
                        y' = Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y
                    return $ case w of
                      Width
    W8  -> OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    UXTB Operand
    x' Operand
    x', Operand -> Operand -> Instr
    UXTB Operand
    y' Operand
    y', Operand -> Operand -> Instr
    CMP Operand
    x' Operand
    y', (CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Cond -> Target -> Instr
    BCOND Cond
    cmp (BlockId -> Target
    TBlock BlockId
    bid))) ]
                      Width
    W16 -> OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    UXTH Operand
    x' Operand
    x', Operand -> Operand -> Instr
    UXTH Operand
    y' Operand
    y', Operand -> Operand -> Instr
    CMP Operand
    x' Operand
    y', (CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Cond -> Target -> Instr
    BCOND Cond
    cmp (BlockId -> Target
    TBlock BlockId
    bid))) ]
                      Width
    _   -> OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [                         Operand -> Operand -> Instr
    CMP Operand
    x' Operand
    y', (CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Cond -> Target -> Instr
    BCOND Cond
    cmp (BlockId -> Target
    TBlock BlockId
    bid))) ]

                sbcond :: Width -> Cond -> NatM (OrdList Instr)
    sbcond Width
    w Cond
    cmp = do
                    -- compute both sides.
                    (reg_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
                    (reg_y, _format_y, code_y) <- getSomeReg y
                    let x' = Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x
                        y' = Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y
                    return $ case w of
                      Width
    W8  -> OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    SXTB Operand
    x' Operand
    x', Operand -> Operand -> Instr
    SXTB Operand
    y' Operand
    y', Operand -> Operand -> Instr
    CMP Operand
    x' Operand
    y', (CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Cond -> Target -> Instr
    BCOND Cond
    cmp (BlockId -> Target
    TBlock BlockId
    bid))) ]
                      Width
    W16 -> OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Instr
    SXTH Operand
    x' Operand
    x', Operand -> Operand -> Instr
    SXTH Operand
    y' Operand
    y', Operand -> Operand -> Instr
    CMP Operand
    x' Operand
    y', (CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Cond -> Target -> Instr
    BCOND Cond
    cmp (BlockId -> Target
    TBlock BlockId
    bid))) ]
                      Width
    _   -> OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [                         Operand -> Operand -> Instr
    CMP Operand
    x' Operand
    y', (CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Cond -> Target -> Instr
    BCOND Cond
    cmp (BlockId -> Target
    TBlock BlockId
    bid))) ]

                fbcond :: Width -> Cond -> NatM (OrdList Instr)
    fbcond Width
    w Cond
    cmp = do
                  -- ensure we get float regs
                  (reg_fx, _format_fx, code_fx) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
    CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getFloatReg CmmExpr
    x
                  (reg_fy, _format_fy, code_fy) <- getFloatReg y
                  return $ code_fx `appOL` code_fy `snocOL` CMP (OpReg w reg_fx) (OpReg w reg_fy) `snocOL` (annExpr expr (BCOND cmp (TBlock bid)))

            case MachOp
    mop of
              MO_F_Eq Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    fbcond Width
    w Cond
    EQ
              MO_F_Ne Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    fbcond Width
    w Cond
    NE

              MO_F_Gt Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    fbcond Width
    w Cond
    OGT
              MO_F_Ge Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    fbcond Width
    w Cond
    OGE
              MO_F_Lt Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    fbcond Width
    w Cond
    OLT
              MO_F_Le Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    fbcond Width
    w Cond
    OLE

              MO_Eq Width
    w   -> Width -> Cond -> NatM (OrdList Instr)
    sbcond Width
    w Cond
    EQ
              MO_Ne Width
    w   -> Width -> Cond -> NatM (OrdList Instr)
    sbcond Width
    w Cond
    NE

              MO_S_Gt Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    sbcond Width
    w Cond
    SGT
              MO_S_Ge Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    sbcond Width
    w Cond
    SGE
              MO_S_Lt Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    sbcond Width
    w Cond
    SLT
              MO_S_Le Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    sbcond Width
    w Cond
    SLE
              MO_U_Gt Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    ubcond Width
    w Cond
    UGT
              MO_U_Ge Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    ubcond Width
    w Cond
    UGE
              MO_U_Lt Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    ubcond Width
    w Cond
    ULT
              MO_U_Le Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    ubcond Width
    w Cond
    ULE
              MachOp
    _ -> String -> SDoc -> NatM (OrdList Instr)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "AArch64.genCondJump:case mop: " (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (String -> SDoc) -> String -> SDoc
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> String
    forall a. Show a => a -> String
    show CmmExpr
    expr)
          CmmExpr
    _ -> String -> SDoc -> NatM (OrdList Instr)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "AArch64.genCondJump: " (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (String -> SDoc) -> String -> SDoc
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> String
    forall a. Show a => a -> String
    show CmmExpr
    expr)

    -- A conditional jump with at least +/-128M jump range
    genCondFarJump :: MonadUnique m => Cond -> Target -> m InstrBlock
    genCondFarJump :: forall (m :: * -> *).
    MonadUnique m =>
    Cond -> Target -> m (OrdList Instr)
    genCondFarJump Cond
    cond Target
    far_target = do
      skip_lbl_id <- m BlockId
    forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
      jmp_lbl_id <- newBlockId

      -- TODO: We can improve this by inverting the condition
      -- but it's not quite trivial since we don't know if we
      -- need to consider float orderings.
      -- So we take the hit of the additional jump in the false
      -- case for now.
      return $ toOL [ BCOND cond (TBlock jmp_lbl_id)
                    , B (TBlock skip_lbl_id)
                    , NEWBLOCK jmp_lbl_id
                    , B far_target
                    , NEWBLOCK skip_lbl_id]

    genCondBranch
        :: BlockId      -- the source of the jump
        -> BlockId      -- the true branch target
        -> BlockId      -- the false branch target
        -> CmmExpr      -- the condition on which to branch
        -> NatM InstrBlock -- Instructions

    genCondBranch :: BlockId -> BlockId -> BlockId -> CmmExpr -> NatM (OrdList Instr)
    genCondBranch BlockId
    _ BlockId
    true BlockId
    false CmmExpr
    expr = do
      b1 <- BlockId -> CmmExpr -> NatM (OrdList Instr)
    genCondJump BlockId
    true CmmExpr
    expr
      b2 <- genBranch false
      return (b1 `appOL` b2)

    -- -----------------------------------------------------------------------------
    --  Generating C calls

    -- Now the biggest nightmare---calls.  Most of the nastiness is buried in
    -- @get_arg@, which moves the arguments to the correct registers/stack
    -- locations.  Apart from that, the code is easy.
    --
    -- As per *convention*:
    -- x0-x7:   (volatile) argument registers
    -- x8:      (volatile) indirect result register / Linux syscall no
    -- x9-x15:  (volatile) caller saved regs
    -- x16,x17: (volatile) intra-procedure-call registers
    -- x18:     (volatile) platform register. don't use for portability
    -- x19-x28: (non-volatile) callee save regs
    -- x29:     (non-volatile) frame pointer
    -- x30:                    link register
    -- x31:                    stack pointer / zero reg
    --
    -- Thus, this is what a c function will expect. Find the arguments in x0-x7,
    -- anything above that on the stack.  We'll ignore c functions with more than
    -- 8 arguments for now.  Sorry.
    --
    -- We need to make sure we preserve x9-x15, don't want to touch x16, x17.

    -- Note [PLT vs GOT relocations]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- When linking objects together, we may need to lookup foreign references. That
    -- is symbolic references to functions or values in other objects. When
    -- compiling the object, we can not know where those elements will end up in
    -- memory (relative to the current location). Thus the use of symbols. There
    -- are two types of items we are interested, code segments we want to jump to
    -- and continue execution there (functions, ...), and data items we want to look
    -- up (strings, numbers, ...). For functions we can use the fact that we can use
    -- an intermediate jump without visibility to the programs execution.  If we
    -- want to jump to a function that is simply too far away to reach for the B/BL
    -- instruction, we can create a small piece of code that loads the full target
    -- address and jumps to that on demand. Say f wants to call g, however g is out
    -- of range for a direct jump, we can create a function h in range for f, that
    -- will load the address of g, and jump there. The area where we construct h
    -- is called the Procedure Linking Table (PLT), we have essentially replaced
    -- f -> g with f -> h -> g.  This is fine for function calls.  However if we
    -- want to lookup values, this trick doesn't work, so we need something else.
    -- We will instead reserve a slot in memory, and have a symbol pointing to that
    -- slot. Now what we essentially do is, we reference that slot, and expect that
    -- slot to hold the final resting address of the data we are interested in.
    -- Thus what that symbol really points to is the location of the final data.
    -- The block of memory where we hold all those slots is the Global Offset Table
    -- (GOT).  Instead of x <- $foo, we now do y <- $fooPtr, and x <- [$y].
    --
    -- For JUMP/CALLs we have 26bits (+/- 128MB), for conditional branches we only
    -- have 19bits (+/- 1MB).  Symbol lookups are also within +/- 1MB, thus for most
    -- of the LOAD/STOREs we'd want to use adrp, and add to compute a value within
    -- 4GB of the PC, and load that.  For anything outside of that range, we'd have
    -- to go through the GOT.
    --
    --  adrp x0, <symbol>
    --  add x0, :lo:<symbol>
    --
    -- will compute the address of <symbol> int x0 if <symbol> is within 4GB of the
    -- PC.
    --
    -- If we want to get the slot in the global offset table (GOT), we can do this:
    --
    --   adrp x0, #:got:<symbol>
    --   ldr x0, [x0, #:got_lo12:<symbol>]
    --
    -- this will compute the address anywhere in the addressable 64bit space into
    -- x0, by loading the address from the GOT slot.
    --
    -- To actually get the value of <symbol>, we'd need to ldr x0, x0 still, which
    -- for the first case can be optimized to use ldr x0, [x0, #:lo12:<symbol>]
    -- instead of the add instruction.
    --
    -- As the memory model for AArch64 for PIC is considered to be +/- 4GB, we do
    -- not need to go through the GOT, unless we want to address the full address
    -- range within 64bit.

    genCCall
        :: ForeignTarget      -- function to call
        -> [CmmFormal]        -- where to put the result
        -> [CmmActual]        -- arguments (of mixed type)
        -> BlockId            -- The block we are in
        -> NatM (InstrBlock, Maybe BlockId)
    -- TODO: Specialize where we can.
    -- Generic impl
    genCCall :: ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> BlockId
    -> NatM (OrdList Instr, Maybe BlockId)
    genCCall ForeignTarget
    target [CmmFormal]
    dest_regs [CmmExpr]
    arg_regs BlockId
    bid = do
      -- we want to pass arg_regs into allArgRegs
      -- pprTraceM "genCCall target" (ppr target)
      -- pprTraceM "genCCall formal" (ppr dest_regs)
      -- pprTraceM "genCCall actual" (ppr arg_regs)
      platform <- NatM Platform
    getPlatform
      case target of
        -- The target :: ForeignTarget call can either
        -- be a foreign procedure with an address expr
        -- and a calling convention.
        ForeignTarget CmmExpr
    expr ForeignConvention
    _cconv -> do
          (call_target, call_target_code) <- case CmmExpr
    expr of
            -- if this is a label, let's just directly to it.  This will produce the
            -- correct CALL relocation for BL...
            (CmmLit (CmmLabel CLabel
    lbl)) -> (Target, OrdList Instr) -> NatM (Target, OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CLabel -> Target
    TLabel CLabel
    lbl, OrdList Instr
    forall a. OrdList a
    nilOL)
            -- ... if it's not a label--well--let's compute the expression into a
            -- register and jump to that. See Note [PLT vs GOT relocations]
            CmmExpr
    _ -> do (reg, _format, reg_code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr
                    pure (TReg reg, reg_code)
          -- compute the code and register logic for all arg_regs.
          -- this will give us the format information to match on.
          arg_regs' <- mapM getSomeReg arg_regs

          -- Now this is stupid.  Our Cmm expressions doesn't carry the proper sizes
          -- so while in Cmm we might get W64 incorrectly for an int, that is W32 in
          -- STG; this thenn breaks packing of stack arguments, if we need to pack
          -- for the pcs, e.g. darwinpcs.  Option one would be to fix the Int type
          -- in Cmm proper. Option two, which we choose here is to use extended Hint
          -- information to contain the size information and use that when packing
          -- arguments, spilled onto the stack.
          let (_res_hints, arg_hints) = foreignTargetHints target
              arg_regs'' = ((Reg, Format, OrdList Instr)
     -> ForeignHint -> (Reg, Format, ForeignHint, OrdList Instr))
    -> [(Reg, Format, OrdList Instr)]
    -> [ForeignHint]
    -> [(Reg, Format, ForeignHint, OrdList Instr)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\(Reg
    r, Format
    f, OrdList Instr
    c) ForeignHint
    h -> (Reg
    r,Format
    f,ForeignHint
    h,OrdList Instr
    c)) [(Reg, Format, OrdList Instr)]
    arg_regs' [ForeignHint]
    arg_hints

          let packStack = Platform -> OS
    platformOS Platform
    platform OS -> OS -> Bool
    forall a. Eq a => a -> a -> Bool
    == OS
    OSDarwin

          (stackSpace', passRegs, passArgumentsCode) <- passArguments packStack allGpArgRegs allFpArgRegs arg_regs'' 0 [] nilOL

          -- if we pack the stack, we may need to adjust to multiple of 8byte.
          -- if we don't pack the stack, it will always be multiple of 8.
          let stackSpace = if Int
    stackSpace' Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    8 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0
                           then Int
    8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    stackSpace' Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
                           else Int
    stackSpace'

          readResultsCode <- readResults allGpArgRegs allFpArgRegs dest_regs [] nilOL

          let moveStackDown Int
    0 = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Instr
    PUSH_STACK_FRAME
                                     , Int -> Instr
    DELTA (-Int
    16) ]
              moveStackDown Int
    i | Int -> Bool
    forall a. Integral a => a -> Bool
    odd Int
    i = Int -> OrdList Instr
    moveStackDown (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
              moveStackDown Int
    i = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Instr
    PUSH_STACK_FRAME
                                     , Operand -> Operand -> Operand -> Instr
    SUB (Width -> Reg -> Operand
    OpReg Width
    W64 (Int -> Reg
    regSingle Int
    31)) (Width -> Reg -> Operand
    OpReg Width
    W64 (Int -> Reg
    regSingle Int
    31)) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt (Int
    8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    i)))
                                     , Int -> Instr
    DELTA (-Int
    8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    16) ]
              moveStackUp Int
    0 = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Instr
    POP_STACK_FRAME
                                   , Int -> Instr
    DELTA Int
    0 ]
              moveStackUp Int
    i | Int -> Bool
    forall a. Integral a => a -> Bool
    odd Int
    i = Int -> OrdList Instr
    moveStackUp (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
              moveStackUp Int
    i = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Operand -> Operand -> Operand -> Instr
    ADD (Width -> Reg -> Operand
    OpReg Width
    W64 (Int -> Reg
    regSingle Int
    31)) (Width -> Reg -> Operand
    OpReg Width
    W64 (Int -> Reg
    regSingle Int
    31)) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt (Int
    8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    i)))
                                   , Instr
    POP_STACK_FRAME
                                   , Int -> Instr
    DELTA Int
    0 ]

          let code =    OrdList Instr
    call_target_code          -- compute the label (possibly into a register)
                OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Int -> OrdList Instr
    moveStackDown (Int
    stackSpace Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    8)
                OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    passArgumentsCode         -- put the arguments into x0, ...
                OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Target -> [Reg] -> Instr
    BL Target
    call_target [Reg]
    passRegs) -- branch and link.
                OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    readResultsCode           -- parse the results into registers
                OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Int -> OrdList Instr
    moveStackUp (Int
    stackSpace Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    8)
          return (code, Nothing)

        PrimTarget CallishMachOp
    MO_F32_Fabs
          | [CmmExpr
    arg_reg] <- [CmmExpr]
    arg_regs, [CmmFormal
    dest_reg] <- [CmmFormal]
    dest_regs ->
            Width
    -> (Operand -> Operand -> OrdList Instr)
    -> CmmExpr
    -> CmmFormal
    -> NatM (OrdList Instr, Maybe BlockId)
    forall {a}.
    Width
    -> (Operand -> Operand -> OrdList Instr)
    -> CmmExpr
    -> CmmFormal
    -> NatM (OrdList Instr, Maybe a)
    unaryFloatOp Width
    W32 (\Operand
    d Operand
    x -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Instr
    FABS Operand
    d Operand
    x) CmmExpr
    arg_reg CmmFormal
    dest_reg
          | Bool
    otherwise -> String -> NatM (OrdList Instr, Maybe BlockId)
    forall a. HasCallStack => String -> a
    panic String
    "mal-formed MO_F32_Fabs"
        PrimTarget CallishMachOp
    MO_F64_Fabs
          | [CmmExpr
    arg_reg] <- [CmmExpr]
    arg_regs, [CmmFormal
    dest_reg] <- [CmmFormal]
    dest_regs ->
            Width
    -> (Operand -> Operand -> OrdList Instr)
    -> CmmExpr
    -> CmmFormal
    -> NatM (OrdList Instr, Maybe BlockId)
    forall {a}.
    Width
    -> (Operand -> Operand -> OrdList Instr)
    -> CmmExpr
    -> CmmFormal
    -> NatM (OrdList Instr, Maybe a)
    unaryFloatOp Width
    W64 (\Operand
    d Operand
    x -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Instr
    FABS Operand
    d Operand
    x) CmmExpr
    arg_reg CmmFormal
    dest_reg
          | Bool
    otherwise -> String -> NatM (OrdList Instr, Maybe BlockId)
    forall a. HasCallStack => String -> a
    panic String
    "mal-formed MO_F64_Fabs"
        PrimTarget CallishMachOp
    MO_F32_Sqrt
          | [CmmExpr
    arg_reg] <- [CmmExpr]
    arg_regs, [CmmFormal
    dest_reg] <- [CmmFormal]
    dest_regs ->
            Width
    -> (Operand -> Operand -> OrdList Instr)
    -> CmmExpr
    -> CmmFormal
    -> NatM (OrdList Instr, Maybe BlockId)
    forall {a}.
    Width
    -> (Operand -> Operand -> OrdList Instr)
    -> CmmExpr
    -> CmmFormal
    -> NatM (OrdList Instr, Maybe a)
    unaryFloatOp Width
    W32 (\Operand
    d Operand
    x -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Instr
    FSQRT Operand
    d Operand
    x) CmmExpr
    arg_reg CmmFormal
    dest_reg
          | Bool
    otherwise -> String -> NatM (OrdList Instr, Maybe BlockId)
    forall a. HasCallStack => String -> a
    panic String
    "mal-formed MO_F32_Sqrt"
        PrimTarget CallishMachOp
    MO_F64_Sqrt
          | [CmmExpr
    arg_reg] <- [CmmExpr]
    arg_regs, [CmmFormal
    dest_reg] <- [CmmFormal]
    dest_regs ->
            Width
    -> (Operand -> Operand -> OrdList Instr)
    -> CmmExpr
    -> CmmFormal
    -> NatM (OrdList Instr, Maybe BlockId)
    forall {a}.
    Width
    -> (Operand -> Operand -> OrdList Instr)
    -> CmmExpr
    -> CmmFormal
    -> NatM (OrdList Instr, Maybe a)
    unaryFloatOp Width
    W64 (\Operand
    d Operand
    x -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Instr
    FSQRT Operand
    d Operand
    x) CmmExpr
    arg_reg CmmFormal
    dest_reg
          | Bool
    otherwise -> String -> NatM (OrdList Instr, Maybe BlockId)
    forall a. HasCallStack => String -> a
    panic String
    "mal-formed MO_F64_Sqrt"

        PrimTarget (MO_S_Mul2 Width
    w)
              -- Life is easier when we're working with word sized operands,
              -- we can use SMULH to compute the high 64 bits, and dst_needed
              -- checks if the high half's bits are all the same as the low half's
              -- top bit.
              | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64
              , [CmmExpr
    src_a, CmmExpr
    src_b] <- [CmmExpr]
    arg_regs
              -- dst_needed = did the result fit into just the low half
              , [CmmFormal
    dst_needed, CmmFormal
    dst_hi, CmmFormal
    dst_lo] <- [CmmFormal]
    dest_regs
                ->  do
                  (reg_a, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    src_a
                  (reg_b, _format_y, code_y) <- getSomeReg src_b

                  let lo = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst_lo)
                      hi = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst_hi)
                      nd = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst_needed)
                  return (
                      code_x `appOL`
                      code_y `snocOL`
                      MUL   (OpReg W64 lo) (OpReg W64 reg_a) (OpReg W64 reg_b) `snocOL`
                      SMULH (OpReg W64 hi) (OpReg W64 reg_a) (OpReg W64 reg_b) `snocOL`
                      -- Are all high bits equal to the sign bit of the low word?
                      -- nd = (hi == ASR(lo,width-1)) ? 1 : 0
                      CMP   (OpReg W64 hi) (OpRegShift W64 lo SASR (widthInBits w - 1)) `snocOL`
                      CSET  (OpReg W64 nd) NE
                      , Nothing)
                -- For sizes < platform width, we can just perform a multiply and shift
                -- using the normal 64 bit multiply. Calculating the dst_needed value is
                -- complicated a little by the need to be careful when truncation happens.
                -- Currently this case can't be generated since
                -- timesInt2# :: Int# -> Int# -> (# Int#, Int#, Int# #)
                -- TODO: Should this be removed or would other primops be useful?
              | Width
    w Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    < Width
    W64
              , [CmmExpr
    src_a, CmmExpr
    src_b] <- [CmmExpr]
    arg_regs
              , [CmmFormal
    dst_needed, CmmFormal
    dst_hi, CmmFormal
    dst_lo] <- [CmmFormal]
    dest_regs
                ->  do
                  (reg_a', _format_x, code_a) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    src_a
                  (reg_b', _format_y, code_b) <- getSomeReg src_b

                  let lo = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst_lo)
                      hi = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst_hi)
                      nd = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst_needed)
                      -- Do everything in a full 64 bit registers
                      w' = Platform -> Width
    platformWordWidth Platform
    platform

                  (reg_a, code_a') <- signExtendReg w w' reg_a'
                  (reg_b, code_b') <- signExtendReg w w' reg_b'

                  return (
                      code_a  `appOL`
                      code_b  `appOL`
                      code_a' `appOL`
                      code_b' `snocOL`
                      -- the low 2w' of lo contains the full multiplication;
                      -- eg: int8 * int8 -> int16 result
                      -- so lo is in the last w of the register, and hi is in the second w.
                      SMULL (OpReg w' lo) (OpReg w' reg_a) (OpReg w' reg_b) `snocOL`
                      -- Make sure we hold onto the sign bits for dst_needed
                      ASR (OpReg w' hi) (OpReg w' lo)    (OpImm (ImmInt $ widthInBits w)) `appOL`
                      -- lo can now be truncated so we can get at it's top bit easily.
                      truncateReg w' w lo `snocOL`
                      -- Note the use of CMN (compare negative), not CMP: we want to
                      -- test if the top half is negative one and the top
                      -- bit of the bottom half is positive one. eg:
                      -- hi = 0b1111_1111  (actually 64 bits)
                      -- lo = 0b1010_1111  (-81, so the result didn't need the top half)
                      -- lo' = ASR(lo,7)   (second reg of SMN)
                      --     = 0b0000_0001 (theeshift gives us 1 for negative,
                      --                    and 0 for positive)
                      -- hi == -lo'?
                      -- 0b1111_1111 == 0b1111_1111 (yes, top half is just overflow)
                      -- Another way to think of this is if hi + lo' == 0, which is what
                      -- CMN really is under the hood.
                      CMN   (OpReg w' hi) (OpRegShift w' lo SLSR (widthInBits w - 1)) `snocOL`
                      -- Set dst_needed to 1 if hi and lo' were (negatively) equal
                      CSET  (OpReg w' nd) EQ `appOL`
                      -- Finally truncate hi to drop any extraneous sign bits.
                      truncateReg w' w hi
                      , Nothing)
              -- Can't handle > 64 bit operands
              | Bool
    otherwise -> CallishMachOp -> NatM (OrdList Instr, Maybe BlockId)
    forall a b. Show a => a -> b
    unsupported (Width -> CallishMachOp
    MO_S_Mul2 Width
    w)
        PrimTarget (MO_U_Mul2  Width
    w)
              -- The unsigned case is much simpler than the signed, all we need to
              -- do is the multiplication straight into the destination registers.
              | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64
              , [CmmExpr
    src_a, CmmExpr
    src_b] <- [CmmExpr]
    arg_regs
              , [CmmFormal
    dst_hi, CmmFormal
    dst_lo] <- [CmmFormal]
    dest_regs
                ->  do
                  (reg_a, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    src_a
                  (reg_b, _format_y, code_y) <- getSomeReg src_b

                  let lo = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst_lo)
                      hi = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst_hi)
                  return (
                      code_x `appOL`
                      code_y `snocOL`
                      MUL   (OpReg W64 lo) (OpReg W64 reg_a) (OpReg W64 reg_b) `snocOL`
                      UMULH (OpReg W64 hi) (OpReg W64 reg_a) (OpReg W64 reg_b)
                      , Nothing)
                -- For sizes < platform width, we can just perform a multiply and shift
                -- Need to be careful to truncate the low half, but the upper half should be
                -- be ok if the invariant in [Signed arithmetic on AArch64] is maintained.
                -- Currently this case can't be produced by the compiler since
                -- timesWord2# :: Word# -> Word# -> (# Word#, Word# #)
                -- TODO: Remove? Or would the extra primop be useful for avoiding the extra
                -- steps needed to do this in userland?
              | Width
    w Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    < Width
    W64
              , [CmmExpr
    src_a, CmmExpr
    src_b] <- [CmmExpr]
    arg_regs
              , [CmmFormal
    dst_hi, CmmFormal
    dst_lo] <- [CmmFormal]
    dest_regs
                ->  do
                  (reg_a, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    src_a
                  (reg_b, _format_y, code_y) <- getSomeReg src_b

                  let lo = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst_lo)
                      hi = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst_hi)
                      w' = Width -> Width
    opRegWidth Width
    w
                  return (
                      code_x `appOL`
                      code_y `snocOL`
                      -- UMULL: Xd = Wa * Wb with 64 bit result
                      -- W64 inputs should have been caught by case above
                      UMULL (OpReg W64 lo) (OpReg w' reg_a) (OpReg w' reg_b) `snocOL`
                      -- Extract and truncate high result
                      -- hi[w:0] = lo[2w:w]
                      UBFX (OpReg W64 hi) (OpReg W64 lo)
                          (OpImm (ImmInt $ widthInBits w)) -- lsb
                          (OpImm (ImmInt $ widthInBits w)) -- width to extract
                          `appOL`
                      truncateReg W64 w lo
                      , Nothing)
              | Bool
    otherwise -> CallishMachOp -> NatM (OrdList Instr, Maybe BlockId)
    forall a b. Show a => a -> b
    unsupported (Width -> CallishMachOp
    MO_U_Mul2  Width
    w)
        PrimTarget (MO_Clz  Width
    w)
              | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 Bool -> Bool -> Bool
    || Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W32
              , [CmmExpr
    src] <- [CmmExpr]
    arg_regs
              , [CmmFormal
    dst] <- [CmmFormal]
    dest_regs
              -> do
                  (reg_a, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    src
                  let dst_reg = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
                  return (
                      code_x `snocOL`
                      CLZ   (OpReg w dst_reg) (OpReg w reg_a)
                      , Nothing)
              | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W16
              , [CmmExpr
    src] <- [CmmExpr]
    arg_regs
              , [CmmFormal
    dst] <- [CmmFormal]
    dest_regs
              -> do
                  (reg_a, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    src
                  let dst' = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
                      r Reg
    n = Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    n
                      imm Int
    n = Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    n)
                  {- dst = clz(x << 16 | 0x0000_8000) -}
                  return (
                      code_x `appOL` toOL
                        [ LSL (r dst') (r reg_a) (imm 16)
                        , ORR (r dst') (r dst')  (imm 0x00008000)
                        , CLZ (r dst') (r dst')
                        ]
                      , Nothing)
              | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8
              , [CmmExpr
    src] <- [CmmExpr]
    arg_regs
              , [CmmFormal
    dst] <- [CmmFormal]
    dest_regs
              -> do
                  (reg_a, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    src
                  let dst' = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
                      r Reg
    n = Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    n
                      imm Int
    n = Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    n)
                  {- dst = clz(x << 24 | 0x0080_0000) -}
                  return (
                      code_x `appOL` toOL
                        [ LSL (r dst') (r reg_a) (imm 24)
                        , ORR (r dst') (r dst')  (imm 0x00800000)
                        , CLZ (r dst') (r dst')
                        ]
                      , Nothing)
                | Bool
    otherwise -> CallishMachOp -> NatM (OrdList Instr, Maybe BlockId)
    forall a b. Show a => a -> b
    unsupported (Width -> CallishMachOp
    MO_Clz  Width
    w)
        PrimTarget (MO_Ctz  Width
    w)
              | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 Bool -> Bool -> Bool
    || Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W32
              , [CmmExpr
    src] <- [CmmExpr]
    arg_regs
              , [CmmFormal
    dst] <- [CmmFormal]
    dest_regs
              -> do
                  (reg_a, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    src
                  let dst_reg = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
                  return (
                      code_x `snocOL`
                      RBIT (OpReg w dst_reg) (OpReg w reg_a) `snocOL`
                      CLZ  (OpReg w dst_reg) (OpReg w dst_reg)
                      , Nothing)
              | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W16
              , [CmmExpr
    src] <- [CmmExpr]
    arg_regs
              , [CmmFormal
    dst] <- [CmmFormal]
    dest_regs
              -> do
                  (reg_a, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    src
                  let dst' = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
                      r Reg
    n = Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    n
                      imm Int
    n = Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    n)
                  {- dst = clz(reverseBits(x) | 0x0000_8000) -}
                  return (
                      code_x `appOL` toOL
                        [ RBIT (r dst') (r reg_a)
                        , ORR  (r dst') (r dst') (imm 0x00008000)
                        , CLZ  (r dst') (r dst')
                        ]
                      , Nothing)
              | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8
              , [CmmExpr
    src] <- [CmmExpr]
    arg_regs
              , [CmmFormal
    dst] <- [CmmFormal]
    dest_regs
              -> do
                  (reg_a, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    src
                  let dst' = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
                      r Reg
    n = Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    n
                      imm Int
    n = Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    n)
                  {- dst = clz(reverseBits(x) | 0x0080_0000) -}
                  return (
                      code_x `appOL` toOL
                        [ RBIT (r dst') (r reg_a)
                        , ORR (r dst')  (r dst') (imm 0x00800000)
                        , CLZ  (r dst')  (r dst')
                        ]
                      , Nothing)
                | Bool
    otherwise -> CallishMachOp -> NatM (OrdList Instr, Maybe BlockId)
    forall a b. Show a => a -> b
    unsupported (Width -> CallishMachOp
    MO_Ctz  Width
    w)
        PrimTarget (MO_BRev  Width
    w)
              | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 Bool -> Bool -> Bool
    || Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W32
              , [CmmExpr
    src] <- [CmmExpr]
    arg_regs
              , [CmmFormal
    dst] <- [CmmFormal]
    dest_regs
              -> do
                  (reg_a, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    src
                  let dst_reg = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
                  return (
                      code_x `snocOL`
                      RBIT (OpReg w dst_reg) (OpReg w reg_a)
                      , Nothing)
              | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W16
              , [CmmExpr
    src] <- [CmmExpr]
    arg_regs
              , [CmmFormal
    dst] <- [CmmFormal]
    dest_regs
              -> do
                  (reg_a, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    src
                  let dst' = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
                      r Reg
    n = Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    n
                      imm Int
    n = Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    n)
                  {- dst = reverseBits32(x << 16) -}
                  return (
                      code_x `appOL` toOL
                        [ LSL  (r dst') (r reg_a) (imm 16)
                        , RBIT (r dst') (r dst')
                        ]
                      , Nothing)
              | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8
              , [CmmExpr
    src] <- [CmmExpr]
    arg_regs
              , [CmmFormal
    dst] <- [CmmFormal]
    dest_regs
              -> do
                  (reg_a, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    src
                  let dst' = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
                      r Reg
    n = Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    n
                      imm Int
    n = Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    n)
                  {- dst = reverseBits32(x << 24) -}
                  return (
                      code_x `appOL` toOL
                        [ LSL  (r dst') (r reg_a) (imm 24)
                        , RBIT (r dst') (r dst')
                        ]
                      , Nothing)
                | Bool
    otherwise -> CallishMachOp -> NatM (OrdList Instr, Maybe BlockId)
    forall a b. Show a => a -> b
    unsupported (Width -> CallishMachOp
    MO_BRev  Width
    w)
        PrimTarget (MO_BSwap  Width
    w)
              | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 Bool -> Bool -> Bool
    || Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W32
              , [CmmExpr
    src] <- [CmmExpr]
    arg_regs
              , [CmmFormal
    dst] <- [CmmFormal]
    dest_regs
              -> do
                  (reg_a, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    src
                  let dst_reg = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
                  return $ (code_x `snocOL` REV (OpReg w dst_reg) (OpReg w reg_a), Nothing)
              | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W16
              , [CmmExpr
    src] <- [CmmExpr]
    arg_regs
              , [CmmFormal
    dst] <- [CmmFormal]
    dest_regs
              -> do
                  (reg_a, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    src
                  let dst' = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
                      r Reg
    n = Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    n
                  -- Swaps the bytes in each 16bit word
                  -- TODO: Expose the 32 & 64 bit version of this?
                  return $ (code_x `snocOL` REV16 (r dst') (r reg_a), Nothing)
              | Bool
    otherwise -> CallishMachOp -> NatM (OrdList Instr, Maybe BlockId)
    forall a b. Show a => a -> b
    unsupported (Width -> CallishMachOp
    MO_BSwap Width
    w)

        -- or a possibly side-effecting machine operation
        -- mop :: CallishMachOp (see GHC.Cmm.MachOp)
        PrimTarget CallishMachOp
    mop -> do
          -- We'll need config to construct forien targets
          case CallishMachOp
    mop of
            -- 64 bit float ops
            CallishMachOp
    MO_F64_Pwr   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "pow"

            CallishMachOp
    MO_F64_Sin   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "sin"
            CallishMachOp
    MO_F64_Cos   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "cos"
            CallishMachOp
    MO_F64_Tan   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "tan"

            CallishMachOp
    MO_F64_Sinh  -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "sinh"
            CallishMachOp
    MO_F64_Cosh  -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "cosh"
            CallishMachOp
    MO_F64_Tanh  -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "tanh"

            CallishMachOp
    MO_F64_Asin  -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "asin"
            CallishMachOp
    MO_F64_Acos  -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "acos"
            CallishMachOp
    MO_F64_Atan  -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "atan"

            CallishMachOp
    MO_F64_Asinh -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "asinh"
            CallishMachOp
    MO_F64_Acosh -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "acosh"
            CallishMachOp
    MO_F64_Atanh -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "atanh"

            CallishMachOp
    MO_F64_Log   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "log"
            CallishMachOp
    MO_F64_Log1P -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "log1p"
            CallishMachOp
    MO_F64_Exp   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "exp"
            CallishMachOp
    MO_F64_ExpM1 -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "expm1"

            -- 32 bit float ops
            CallishMachOp
    MO_F32_Pwr   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "powf"

            CallishMachOp
    MO_F32_Sin   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "sinf"
            CallishMachOp
    MO_F32_Cos   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "cosf"
            CallishMachOp
    MO_F32_Tan   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "tanf"
            CallishMachOp
    MO_F32_Sinh  -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "sinhf"
            CallishMachOp
    MO_F32_Cosh  -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "coshf"
            CallishMachOp
    MO_F32_Tanh  -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "tanhf"
            CallishMachOp
    MO_F32_Asin  -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "asinf"
            CallishMachOp
    MO_F32_Acos  -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "acosf"
            CallishMachOp
    MO_F32_Atan  -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "atanf"
            CallishMachOp
    MO_F32_Asinh -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "asinhf"
            CallishMachOp
    MO_F32_Acosh -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "acoshf"
            CallishMachOp
    MO_F32_Atanh -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "atanhf"
            CallishMachOp
    MO_F32_Log   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "logf"
            CallishMachOp
    MO_F32_Log1P -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "log1pf"
            CallishMachOp
    MO_F32_Exp   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "expf"
            CallishMachOp
    MO_F32_ExpM1 -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "expm1f"

            -- 64-bit primops
            CallishMachOp
    MO_I64_ToI   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_int64ToInt"
            CallishMachOp
    MO_I64_FromI -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_intToInt64"
            CallishMachOp
    MO_W64_ToW   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_word64ToWord"
            CallishMachOp
    MO_W64_FromW -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_wordToWord64"
            CallishMachOp
    MO_x64_Neg   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_neg64"
            CallishMachOp
    MO_x64_Add   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_add64"
            CallishMachOp
    MO_x64_Sub   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_sub64"
            CallishMachOp
    MO_x64_Mul   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_mul64"
            CallishMachOp
    MO_I64_Quot  -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_quotInt64"
            CallishMachOp
    MO_I64_Rem   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_remInt64"
            CallishMachOp
    MO_W64_Quot  -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_quotWord64"
            CallishMachOp
    MO_W64_Rem   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_remWord64"
            CallishMachOp
    MO_x64_And   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_and64"
            CallishMachOp
    MO_x64_Or    -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_or64"
            CallishMachOp
    MO_x64_Xor   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_xor64"
            CallishMachOp
    MO_x64_Not   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_not64"
            CallishMachOp
    MO_x64_Shl   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_uncheckedShiftL64"
            CallishMachOp
    MO_I64_Shr   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_uncheckedIShiftRA64"
            CallishMachOp
    MO_W64_Shr   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_uncheckedShiftRL64"
            CallishMachOp
    MO_x64_Eq    -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_eq64"
            CallishMachOp
    MO_x64_Ne    -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_ne64"
            CallishMachOp
    MO_I64_Ge    -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_geInt64"
            CallishMachOp
    MO_I64_Gt    -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_gtInt64"
            CallishMachOp
    MO_I64_Le    -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_leInt64"
            CallishMachOp
    MO_I64_Lt    -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_ltInt64"
            CallishMachOp
    MO_W64_Ge    -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_geWord64"
            CallishMachOp
    MO_W64_Gt    -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_gtWord64"
            CallishMachOp
    MO_W64_Le    -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_leWord64"
            CallishMachOp
    MO_W64_Lt    -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "hs_ltWord64"

            -- Conversion
            MO_UF_Conv Width
    w        -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall (Width -> FastString
    word2FloatLabel Width
    w)

            -- Arithmatic
            -- These are not supported on X86, so I doubt they are used much.
            MO_S_QuotRem  Width
    _w -> CallishMachOp -> NatM (OrdList Instr, Maybe BlockId)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
            MO_U_QuotRem  Width
    _w -> CallishMachOp -> NatM (OrdList Instr, Maybe BlockId)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
            MO_U_QuotRem2 Width
    _w -> CallishMachOp -> NatM (OrdList Instr, Maybe BlockId)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
            MO_Add2       Width
    _w -> CallishMachOp -> NatM (OrdList Instr, Maybe BlockId)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
            MO_AddWordC   Width
    _w -> CallishMachOp -> NatM (OrdList Instr, Maybe BlockId)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
            MO_SubWordC   Width
    _w -> CallishMachOp -> NatM (OrdList Instr, Maybe BlockId)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
            MO_AddIntC    Width
    _w -> CallishMachOp -> NatM (OrdList Instr, Maybe BlockId)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
            MO_SubIntC    Width
    _w -> CallishMachOp -> NatM (OrdList Instr, Maybe BlockId)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop

            -- Memory Ordering
            CallishMachOp
    MO_AcquireFence     ->  (OrdList Instr, Maybe BlockId)
    -> NatM (OrdList Instr, Maybe BlockId)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL Instr
    DMBISH, Maybe BlockId
    forall a. Maybe a
    Nothing)
            CallishMachOp
    MO_ReleaseFence     ->  (OrdList Instr, Maybe BlockId)
    -> NatM (OrdList Instr, Maybe BlockId)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL Instr
    DMBISH, Maybe BlockId
    forall a. Maybe a
    Nothing)
            CallishMachOp
    MO_SeqCstFence      ->  (OrdList Instr, Maybe BlockId)
    -> NatM (OrdList Instr, Maybe BlockId)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL Instr
    DMBISH, Maybe BlockId
    forall a. Maybe a
    Nothing)
            CallishMachOp
    MO_Touch            ->  (OrdList Instr, Maybe BlockId)
    -> NatM (OrdList Instr, Maybe BlockId)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    forall a. OrdList a
    nilOL, Maybe BlockId
    forall a. Maybe a
    Nothing) -- Keep variables live (when using interior pointers)
            -- Prefetch
            MO_Prefetch_Data Int
    _n -> (OrdList Instr, Maybe BlockId)
    -> NatM (OrdList Instr, Maybe BlockId)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    forall a. OrdList a
    nilOL, Maybe BlockId
    forall a. Maybe a
    Nothing) -- Prefetch hint.

            -- Memory copy/set/move/cmp, with alignment for optimization

            -- TODO Optimize and use e.g. quad registers to move memory around instead
            -- of offloading this to memcpy. For small memcpys we can utilize
            -- the 128bit quad registers in NEON to move block of bytes around.
            -- Might also make sense of small memsets? Use xzr? What's the function
            -- call overhead?
            MO_Memcpy  Int
    _align   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "memcpy"
            MO_Memset  Int
    _align   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "memset"
            MO_Memmove Int
    _align   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "memmove"
            MO_Memcmp  Int
    _align   -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "memcmp"

            CallishMachOp
    MO_SuspendThread    -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "suspendThread"
            CallishMachOp
    MO_ResumeThread     -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    "resumeThread"

            MO_PopCnt Width
    w         -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall (Width -> FastString
    popCntLabel Width
    w)
            MO_Pdep Width
    w           -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall (Width -> FastString
    pdepLabel Width
    w)
            MO_Pext Width
    w           -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall (Width -> FastString
    pextLabel Width
    w)

            -- -- Atomic read-modify-write.
            MO_AtomicRead Width
    w MemoryOrdering
    ord
              | [CmmExpr
    p_reg] <- [CmmExpr]
    arg_regs
              , [CmmFormal
    dst_reg] <- [CmmFormal]
    dest_regs -> do
                  (p, _fmt_p, code_p) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    p_reg
                  platform <- getPlatform
                  let instr = case MemoryOrdering
    ord of
                          MemoryOrdering
    MemOrderRelaxed -> Format -> Operand -> Operand -> Instr
    LDR
                          MemoryOrdering
    _               -> Format -> Operand -> Operand -> Instr
    LDAR
                      dst = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst_reg)
                      code =
                        OrdList Instr
    code_p OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                        Format -> Operand -> Operand -> Instr
    instr (Width -> Format
    intFormat Width
    w) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (AddrMode -> Operand
    OpAddr (AddrMode -> Operand) -> AddrMode -> Operand
    forall a b. (a -> b) -> a -> b
    $ Reg -> AddrMode
    AddrReg Reg
    p)
                  return (code, Nothing)
              | Bool
    otherwise -> String -> NatM (OrdList Instr, Maybe BlockId)
    forall a. HasCallStack => String -> a
    panic String
    "mal-formed AtomicRead"
            MO_AtomicWrite Width
    w MemoryOrdering
    ord
              | [CmmExpr
    p_reg, CmmExpr
    val_reg] <- [CmmExpr]
    arg_regs -> do
                  (p, _fmt_p, code_p) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    p_reg
                  (val, fmt_val, code_val) <- getSomeReg val_reg
                  let instr = case MemoryOrdering
    ord of
                          MemoryOrdering
    MemOrderRelaxed -> Format -> Operand -> Operand -> Instr
    STR
                          MemoryOrdering
    _               -> Format -> Operand -> Operand -> Instr
    STLR
                      code =
                        OrdList Instr
    code_p OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                        OrdList Instr
    code_val OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                        Format -> Operand -> Operand -> Instr
    instr Format
    fmt_val (Width -> Reg -> Operand
    OpReg Width
    w Reg
    val) (AddrMode -> Operand
    OpAddr (AddrMode -> Operand) -> AddrMode -> Operand
    forall a b. (a -> b) -> a -> b
    $ Reg -> AddrMode
    AddrReg Reg
    p)
                  return (code, Nothing)
              | Bool
    otherwise -> String -> NatM (OrdList Instr, Maybe BlockId)
    forall a. HasCallStack => String -> a
    panic String
    "mal-formed AtomicWrite"
            MO_AtomicRMW Width
    w AtomicMachOp
    amop -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall (Width -> AtomicMachOp -> FastString
    atomicRMWLabel Width
    w AtomicMachOp
    amop)
            MO_Cmpxchg Width
    w        -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall (Width -> FastString
    cmpxchgLabel Width
    w)
            -- -- Should be an AtomicRMW variant eventually.
            -- -- Sequential consistent.
            -- TODO: this should be implemented properly!
            MO_Xchg Width
    w           -> FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall (Width -> FastString
    xchgLabel Width
    w)

      where
        unsupported :: Show a => a -> b
        unsupported :: forall a b. Show a => a -> b
    unsupported a
    mop = String -> b
    forall a. HasCallStack => String -> a
    panic (String
    "outOfLineCmmOp: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    mop
                              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " not supported here")
        mkCCall :: FastString -> NatM (InstrBlock, Maybe BlockId)
        mkCCall :: FastString -> NatM (OrdList Instr, Maybe BlockId)
    mkCCall FastString
    name = do
          config <- NatM NCGConfig
    getConfig
          target <- cmmMakeDynamicReference config CallReference $
              mkForeignLabel name Nothing ForeignLabelInThisPackage IsFunction
          let cconv = CCallConv
    -> [ForeignHint]
    -> [ForeignHint]
    -> CmmReturnInfo
    -> ForeignConvention
    ForeignConvention CCallConv
    CCallConv [ForeignHint
    NoHint] [ForeignHint
    NoHint] CmmReturnInfo
    CmmMayReturn
          genCCall (ForeignTarget target cconv) dest_regs arg_regs bid

        -- TODO: Optimize using paired stores and loads (STP, LDP). It is
        -- automatically done by the allocator for us. However it's not optimal,
        -- as we'd rather want to have control over
        --     all spill/load registers, so we can optimize with instructions like
        --       STP xA, xB, [sp, #-16]!
        --     and
        --       LDP xA, xB, sp, #16
        --
        passArguments :: Bool -> [Reg] -> [Reg] -> [(Reg, Format, ForeignHint, InstrBlock)] -> Int -> [Reg] -> InstrBlock -> NatM (Int, [Reg], InstrBlock)
        passArguments :: Bool
    -> [Reg]
    -> [Reg]
    -> [(Reg, Format, ForeignHint, OrdList Instr)]
    -> Int
    -> [Reg]
    -> OrdList Instr
    -> NatM (Int, [Reg], OrdList Instr)
    passArguments Bool
    _packStack [Reg]
    _ [Reg]
    _ [] Int
    stackSpace [Reg]
    accumRegs OrdList Instr
    accumCode = (Int, [Reg], OrdList Instr) -> NatM (Int, [Reg], OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    stackSpace, [Reg]
    accumRegs, OrdList Instr
    accumCode)
        -- passArguments _ _ [] accumCode stackSpace | isEven stackSpace = return $ SUM (OpReg W64 x31) (OpReg W64 x31) OpImm (ImmInt (-8 * stackSpace))
        -- passArguments _ _ [] accumCode stackSpace = return $ SUM (OpReg W64 x31) (OpReg W64 x31) OpImm (ImmInt (-8 * (stackSpace + 1)))
        -- passArguments [] fpRegs (arg0:arg1:args) stack accumCode = do
        --   -- allocate this on the stack
        --   (r0, format0, code_r0) <- getSomeReg arg0
        --   (r1, format1, code_r1) <- getSomeReg arg1
        --   let w0 = formatToWidth format0
        --       w1 = formatToWidth format1
        --       stackCode = unitOL $ STP (OpReg w0 r0) (OpReg w1 R1), (OpAddr (AddrRegImm x31 (ImmInt (stackSpace * 8)))
        --   passArguments gpRegs (fpReg:fpRegs) args (stackCode `appOL` accumCode)

          -- float promotion.
          -- According to
          --  ISO/IEC 9899:2018
          --  Information technology — Programming languages — C
          --
          -- e.g.
          -- http://www.open-std.org/jtc1/sc22/wg14/www/docs/n1124.pdf
          -- http://www.open-std.org/jtc1/sc22/wg14/www/docs/n1256.pdf
          --
          -- GHC would need to know the prototype.
          --
          -- > If the expression that denotes the called function has a type that does not include a
          -- > prototype, the integer promotions are performed on each argument, and arguments that
          -- > have type float are promoted to double.
          --
          -- As we have no way to get prototypes for C yet, we'll *not* promote this
          -- which is in line with the x86_64 backend :(
          --
          -- See the encode_values.cmm test.
          --
          -- We would essentially need to insert an FCVT (OpReg W64 fpReg) (OpReg W32 fpReg)
          -- if w == W32.  But *only* if we don't have a prototype m(
          --
          -- For AArch64 specificies see: https://developer.arm.com/docs/ihi0055/latest/procedure-call-standard-for-the-arm-64-bit-architecture
          --
        -- Still have GP regs, and we want to pass an GP argument.

        -- AArch64-Darwin: stack packing and alignment
        --
        -- According to the "Writing ARM64 Code for Apple Platforms" document form
        -- Apple, specifically the section "Handle Data Types and Data Alignment Properly"
        -- we need to not only pack, but also align arguments on the stack.
        --
        -- Data type   Size (in bytes)   Natural alignment (in bytes)
        -- BOOL, bool  1                 1
        -- char        1                 1
        -- short       2                 2
        -- int         4                 4
        -- long        8                 8
        -- long long   8                 8
        -- pointer     8                 8
        -- size_t      8                 8
        -- NSInteger   8                 8
        -- CFIndex     8                 8
        -- fpos_t      8                 8
        -- off_t       8                 8
        --
        -- We can see that types are aligned by their sizes so the easiest way to
        -- guarantee alignment during packing seems to be to pad to a multiple of the
        -- size we want to pack. Failure to get this right can result in pretty
        -- subtle bugs, e.g. #20137.

        passArguments Bool
    pack (Reg
    gpReg:[Reg]
    gpRegs) [Reg]
    fpRegs ((Reg
    r, Format
    format, ForeignHint
    hint, OrdList Instr
    code_r):[(Reg, Format, ForeignHint, OrdList Instr)]
    args) Int
    stackSpace [Reg]
    accumRegs OrdList Instr
    accumCode | Format -> Bool
    isIntFormat Format
    format = do
          platform <- NatM Platform
    getPlatform
          let w = Format -> Width
    formatToWidth Format
    format
              mov
                -- Specifically, Darwin/AArch64's ABI requires that the caller
                -- sign-extend arguments which are smaller than 32-bits.
                | Width
    w Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    < Width
    W32
                , Platform -> Bool
    platformCConvNeedsExtension Platform
    platform
                , ForeignHint
    SignedHint <- ForeignHint
    hint
                = case Width
    w of
                    Width
    W8  -> Operand -> Operand -> Instr
    SXTB (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    gpReg) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r)
                    Width
    W16 -> Operand -> Operand -> Instr
    SXTH (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    gpReg) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r)
                    Width
    _   -> String -> Instr
    forall a. HasCallStack => String -> a
    panic String
    "impossible"
                | Bool
    otherwise
                = Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    w Reg
    gpReg) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r)
              accumCode' = OrdList Instr
    accumCode OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                           OrdList Instr
    code_r OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                           SDoc -> Instr -> Instr
    ann (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Pass gp argument: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r) Instr
    mov
          passArguments pack gpRegs fpRegs args stackSpace (gpReg:accumRegs) accumCode'

        -- Still have FP regs, and we want to pass an FP argument.
        passArguments Bool
    pack [Reg]
    gpRegs (Reg
    fpReg:[Reg]
    fpRegs) ((Reg
    r, Format
    format, ForeignHint
    _hint, OrdList Instr
    code_r):[(Reg, Format, ForeignHint, OrdList Instr)]
    args) Int
    stackSpace [Reg]
    accumRegs OrdList Instr
    accumCode | Format -> Bool
    isFloatFormat Format
    format = do
          let w :: Width
    w = Format -> Width
    formatToWidth Format
    format
              mov :: Instr
    mov = Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    w Reg
    fpReg) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r)
              accumCode' :: OrdList Instr
    accumCode' = OrdList Instr
    accumCode OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                           OrdList Instr
    code_r OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                           SDoc -> Instr -> Instr
    ann (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Pass fp argument: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r) Instr
    mov
          Bool
    -> [Reg]
    -> [Reg]
    -> [(Reg, Format, ForeignHint, OrdList Instr)]
    -> Int
    -> [Reg]
    -> OrdList Instr
    -> NatM (Int, [Reg], OrdList Instr)
    passArguments Bool
    pack [Reg]
    gpRegs [Reg]
    fpRegs [(Reg, Format, ForeignHint, OrdList Instr)]
    args Int
    stackSpace (Reg
    fpRegReg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    :[Reg]
    accumRegs) OrdList Instr
    accumCode'

        -- No mor regs left to pass. Must pass on stack.
        passArguments Bool
    pack [] [] ((Reg
    r, Format
    format, ForeignHint
    _hint, OrdList Instr
    code_r):[(Reg, Format, ForeignHint, OrdList Instr)]
    args) Int
    stackSpace [Reg]
    accumRegs OrdList Instr
    accumCode = do
          let w :: Width
    w = Format -> Width
    formatToWidth Format
    format
              bytes :: Int
    bytes = Width -> Int
    widthInBits Width
    w Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    8
              space :: Int
    space = if Bool
    pack then Int
    bytes else Int
    8
              stackSpace' :: Int
    stackSpace' | Bool
    pack Bool -> Bool -> Bool
    && Int
    stackSpace Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    space Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0 = Int
    stackSpace Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    space Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    stackSpace Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    space)
                          | Bool
    otherwise                           = Int
    stackSpace
              str :: Instr
    str = Format -> Operand -> Operand -> Instr
    STR Format
    format (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r) (AddrMode -> Operand
    OpAddr (Reg -> Imm -> AddrMode
    AddrRegImm (Int -> Reg
    regSingle Int
    31) (Int -> Imm
    ImmInt Int
    stackSpace')))
              stackCode :: OrdList Instr
    stackCode = OrdList Instr
    code_r OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                          SDoc -> Instr -> Instr
    ann (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Pass argument (size " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    ") on the stack: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r) Instr
    str
          Bool
    -> [Reg]
    -> [Reg]
    -> [(Reg, Format, ForeignHint, OrdList Instr)]
    -> Int
    -> [Reg]
    -> OrdList Instr
    -> NatM (Int, [Reg], OrdList Instr)
    passArguments Bool
    pack [] [] [(Reg, Format, ForeignHint, OrdList Instr)]
    args (Int
    stackSpace'Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    space) [Reg]
    accumRegs (OrdList Instr
    stackCode OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    accumCode)

        -- Still have fpRegs left, but want to pass a GP argument. Must be passed on the stack then.
        passArguments Bool
    pack [] [Reg]
    fpRegs ((Reg
    r, Format
    format, ForeignHint
    _hint, OrdList Instr
    code_r):[(Reg, Format, ForeignHint, OrdList Instr)]
    args) Int
    stackSpace [Reg]
    accumRegs OrdList Instr
    accumCode | Format -> Bool
    isIntFormat Format
    format = do
          let w :: Width
    w = Format -> Width
    formatToWidth Format
    format
              bytes :: Int
    bytes = Width -> Int
    widthInBits Width
    w Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    8
              space :: Int
    space = if Bool
    pack then Int
    bytes else Int
    8
              stackSpace' :: Int
    stackSpace' | Bool
    pack Bool -> Bool -> Bool
    && Int
    stackSpace Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    space Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0 = Int
    stackSpace Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    space Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    stackSpace Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    space)
                          | Bool
    otherwise                           = Int
    stackSpace
              str :: Instr
    str = Format -> Operand -> Operand -> Instr
    STR Format
    format (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r) (AddrMode -> Operand
    OpAddr (Reg -> Imm -> AddrMode
    AddrRegImm (Int -> Reg
    regSingle Int
    31) (Int -> Imm
    ImmInt Int
    stackSpace')))
              stackCode :: OrdList Instr
    stackCode = OrdList Instr
    code_r OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                          SDoc -> Instr -> Instr
    ann (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Pass argument (size " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    ") on the stack: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r) Instr
    str
          Bool
    -> [Reg]
    -> [Reg]
    -> [(Reg, Format, ForeignHint, OrdList Instr)]
    -> Int
    -> [Reg]
    -> OrdList Instr
    -> NatM (Int, [Reg], OrdList Instr)
    passArguments Bool
    pack [] [Reg]
    fpRegs [(Reg, Format, ForeignHint, OrdList Instr)]
    args (Int
    stackSpace'Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    space) [Reg]
    accumRegs (OrdList Instr
    stackCode OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    accumCode)

        -- Still have gpRegs left, but want to pass a FP argument. Must be passed on the stack then.
        passArguments Bool
    pack [Reg]
    gpRegs [] ((Reg
    r, Format
    format, ForeignHint
    _hint, OrdList Instr
    code_r):[(Reg, Format, ForeignHint, OrdList Instr)]
    args) Int
    stackSpace [Reg]
    accumRegs OrdList Instr
    accumCode | Format -> Bool
    isFloatFormat Format
    format = do
          let w :: Width
    w = Format -> Width
    formatToWidth Format
    format
              bytes :: Int
    bytes = Width -> Int
    widthInBits Width
    w Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    8
              space :: Int
    space = if Bool
    pack then Int
    bytes else Int
    8
              stackSpace' :: Int
    stackSpace' | Bool
    pack Bool -> Bool -> Bool
    && Int
    stackSpace Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    space Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0 = Int
    stackSpace Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    space Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    stackSpace Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    space)
                          | Bool
    otherwise                           = Int
    stackSpace
              str :: Instr
    str = Format -> Operand -> Operand -> Instr
    STR Format
    format (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r) (AddrMode -> Operand
    OpAddr (Reg -> Imm -> AddrMode
    AddrRegImm (Int -> Reg
    regSingle Int
    31) (Int -> Imm
    ImmInt Int
    stackSpace')))
              stackCode :: OrdList Instr
    stackCode = OrdList Instr
    code_r OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                          SDoc -> Instr -> Instr
    ann (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Pass argument (size " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    ") on the stack: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r) Instr
    str
          Bool
    -> [Reg]
    -> [Reg]
    -> [(Reg, Format, ForeignHint, OrdList Instr)]
    -> Int
    -> [Reg]
    -> OrdList Instr
    -> NatM (Int, [Reg], OrdList Instr)
    passArguments Bool
    pack [Reg]
    gpRegs [] [(Reg, Format, ForeignHint, OrdList Instr)]
    args (Int
    stackSpace'Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    space) [Reg]
    accumRegs (OrdList Instr
    stackCode OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    accumCode)

        passArguments Bool
    _ [Reg]
    _ [Reg]
    _ [(Reg, Format, ForeignHint, OrdList Instr)]
    _ Int
    _ [Reg]
    _ OrdList Instr
    _ = String -> SDoc -> NatM (Int, [Reg], OrdList Instr)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "passArguments" (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "invalid state")

        readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg]-> InstrBlock -> NatM (InstrBlock)
        readResults :: [Reg]
    -> [Reg]
    -> [CmmFormal]
    -> [Reg]
    -> OrdList Instr
    -> NatM (OrdList Instr)
    readResults [Reg]
    _ [Reg]
    _ [] [Reg]
    _ OrdList Instr
    accumCode = OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    accumCode
        readResults [] [Reg]
    _ [CmmFormal]
    _ [Reg]
    _ OrdList Instr
    _ = do
          platform <- NatM Platform
    getPlatform
          pprPanic "genCCall, out of gp registers when reading results" (pdoc platform target)
        readResults [Reg]
    _ [] [CmmFormal]
    _ [Reg]
    _ OrdList Instr
    _ = do
          platform <- NatM Platform
    getPlatform
          pprPanic "genCCall, out of fp registers when reading results" (pdoc platform target)
        readResults (Reg
    gpReg:[Reg]
    gpRegs) (Reg
    fpReg:[Reg]
    fpRegs) (CmmFormal
    dst:[CmmFormal]
    dsts) [Reg]
    accumRegs OrdList Instr
    accumCode = do
          -- gp/fp reg -> dst
          platform <- NatM Platform
    getPlatform
          let rep = CmmReg -> CmmType
    cmmRegType (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
              format = CmmType -> Format
    cmmTypeFormat CmmType
    rep
              w   = CmmReg -> Width
    cmmRegWidth (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
              r_dst = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
          if isFloatFormat format
            then readResults (gpReg:gpRegs) fpRegs dsts (fpReg:accumRegs) (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w fpReg))
            else readResults gpRegs (fpReg:fpRegs) dsts (gpReg:accumRegs) (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w gpReg))

        unaryFloatOp :: Width
    -> (Operand -> Operand -> OrdList Instr)
    -> CmmExpr
    -> CmmFormal
    -> NatM (OrdList Instr, Maybe a)
    unaryFloatOp Width
    w Operand -> Operand -> OrdList Instr
    op CmmExpr
    arg_reg CmmFormal
    dest_reg = do
          platform <- NatM Platform
    getPlatform
          (reg_fx, _format_x, code_fx) <- getFloatReg arg_reg
          let dst = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dest_reg)
          let code = OrdList Instr
    code_fx OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Operand -> Operand -> OrdList Instr
    op (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_fx)
          return (code, Nothing)

    {- Note [AArch64 far jumps]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    AArch conditional jump instructions can only encode an offset of +/-1MB
    which is usually enough but can be exceeded in edge cases. In these cases
    we will replace:

      b.cond <cond> foo

    with the sequence:

      b.cond <cond> <lbl_true>
      b <lbl_false>
      <lbl_true>:
      b foo
      <lbl_false>:

    Note the encoding of the `b` instruction still limits jumps to
    +/-128M offsets, but that seems like an acceptable limitation.

    Since AArch64 instructions are all of equal length we can reasonably estimate jumps
    in range by counting the instructions between a jump and its target label.

    We make some simplifications in the name of performance which can result in overestimating
    jump <-> label offsets:

    * To avoid having to recalculate the label offsets once we replaced a jump we simply
      assume all jumps will be expanded to a three instruction far jump sequence.
    * For labels associated with a info table we assume the info table is 64byte large.
      Most info tables are smaller than that but it means we don't have to distinguish
      between multiple types of info tables.

    In terms of implementation we walk the instruction stream at least once calculating
    label offsets, and if we determine during this that the functions body is big enough
    to potentially contain out of range jumps we walk the instructions a second time, replacing
    out of range jumps with the sequence of instructions described above.

    -}

    -- See Note [AArch64 far jumps]
    data BlockInRange = InRange | NotInRange Target

    -- See Note [AArch64 far jumps]
    makeFarBranches :: Platform -> LabelMap RawCmmStatics -> [NatBasicBlock Instr]
                    -> UniqSM [NatBasicBlock Instr]
    makeFarBranches :: Platform
    -> LabelMap RawCmmStatics
    -> [NatBasicBlock Instr]
    -> UniqSM [NatBasicBlock Instr]
    makeFarBranches {- only used when debugging -} Platform
    _platform LabelMap RawCmmStatics
    statics [NatBasicBlock Instr]
    basic_blocks = do
      -- All offsets/positions are counted in multiples of 4 bytes (the size of AArch64 instructions)
      -- That is an offset of 1 represents a 4-byte/one instruction offset.
      let (Int
    func_size, LabelMap Int
    lblMap) = ((Int, LabelMap Int) -> NatBasicBlock Instr -> (Int, LabelMap Int))
    -> (Int, LabelMap Int)
    -> [NatBasicBlock Instr]
    -> (Int, LabelMap Int)
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (Int, LabelMap Int) -> NatBasicBlock Instr -> (Int, LabelMap Int)
    calc_lbl_positions (Int
    0, LabelMap Int
    forall v. LabelMap v
    mapEmpty) [NatBasicBlock Instr]
    basic_blocks
      if Int
    func_size Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    max_jump_dist
        then [NatBasicBlock Instr] -> UniqSM [NatBasicBlock Instr]
    forall a. a -> UniqSM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [NatBasicBlock Instr]
    basic_blocks
        else do
          (_,blocks) <- (Int -> NatBasicBlock Instr -> UniqSM (Int, [NatBasicBlock Instr]))
    -> Int
    -> [NatBasicBlock Instr]
    -> UniqSM (Int, [[NatBasicBlock Instr]])
    forall (m :: * -> *) (t :: * -> *) acc x y.
    (Monad m, Traversable t) =>
    (acc -> x -> m (acc, y)) -> acc -> t x -> m (acc, t y)
    mapAccumLM (LabelMap Int
    -> Int
    -> NatBasicBlock Instr
    -> UniqSM (Int, [NatBasicBlock Instr])
    replace_blk LabelMap Int
    lblMap) Int
    0 [NatBasicBlock Instr]
    basic_blocks
          pure $ concat blocks
          -- pprTrace "lblMap" (ppr lblMap) $ basic_blocks

      where
        -- 2^18, 19 bit immediate with one bit is reserved for the sign
        max_jump_dist :: Int
    max_jump_dist = Int
    2Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    18::Int) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 :: Int
        -- Currently all inline info tables fit into 64 bytes.
        max_info_size :: Int
    max_info_size     = Int
    16 :: Int
        long_bc_jump_size :: Int
    long_bc_jump_size =  Int
    3 :: Int
        long_bz_jump_size :: Int
    long_bz_jump_size =  Int
    4 :: Int

        -- Replace out of range conditional jumps with unconditional jumps.
        replace_blk :: LabelMap Int -> Int -> GenBasicBlock Instr -> UniqSM (Int, [GenBasicBlock Instr])
        replace_blk :: LabelMap Int
    -> Int
    -> NatBasicBlock Instr
    -> UniqSM (Int, [NatBasicBlock Instr])
    replace_blk !LabelMap Int
    m !Int
    pos (BasicBlock BlockId
    lbl [Instr]
    instrs) = do
          -- Account for a potential info table before the label.
          let !block_pos :: Int
    block_pos = Int
    pos Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + BlockId -> Int
    infoTblSize_maybe BlockId
    lbl
          (!pos', instrs') <- (Int -> Instr -> UniqSM (Int, [Instr]))
    -> Int -> [Instr] -> UniqSM (Int, [[Instr]])
    forall (m :: * -> *) (t :: * -> *) acc x y.
    (Monad m, Traversable t) =>
    (acc -> x -> m (acc, y)) -> acc -> t x -> m (acc, t y)
    mapAccumLM (LabelMap Int -> Int -> Instr -> UniqSM (Int, [Instr])
    replace_jump LabelMap Int
    m) Int
    block_pos [Instr]
    instrs
          let instrs'' = [[Instr]] -> [Instr]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Instr]]
    instrs'
          -- We might have introduced new labels, so split the instructions into basic blocks again if neccesary.
          let (top, split_blocks, no_data) = foldr mkBlocks ([],[],[]) instrs''
          -- There should be no data in the instruction stream at this point
          massert (null no_data)

          let final_blocks = BlockId -> [Instr] -> NatBasicBlock Instr
    forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    lbl [Instr]
    top NatBasicBlock Instr
    -> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
    forall a. a -> [a] -> [a]
    : [NatBasicBlock Instr]
    split_blocks
          pure (pos', final_blocks)

        replace_jump :: LabelMap Int -> Int -> Instr -> UniqSM (Int, [Instr])
        replace_jump :: LabelMap Int -> Int -> Instr -> UniqSM (Int, [Instr])
    replace_jump !LabelMap Int
    m !Int
    pos Instr
    instr = do
          case Instr
    instr of
            ANN SDoc
    ann Instr
    instr -> do
              (idx,instr':instrs') <- LabelMap Int -> Int -> Instr -> UniqSM (Int, [Instr])
    replace_jump LabelMap Int
    m Int
    pos Instr
    instr
              pure (idx, ANN ann instr':instrs')
            BCOND Cond
    cond Target
    t
              -> case LabelMap Int -> Target -> Int -> BlockInRange
    target_in_range LabelMap Int
    m Target
    t Int
    pos of
                  BlockInRange
    InRange -> (Int, [Instr]) -> UniqSM (Int, [Instr])
    forall a. a -> UniqSM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    posInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    long_bc_jump_size,[Instr
    instr])
                  NotInRange Target
    far_target -> do
                    jmp_code <- Cond -> Target -> UniqSM (OrdList Instr)
    forall (m :: * -> *).
    MonadUnique m =>
    Cond -> Target -> m (OrdList Instr)
    genCondFarJump Cond
    cond Target
    far_target
                    pure (pos+long_bc_jump_size, fromOL jmp_code)
            CBZ Operand
    op Target
    t -> Operand -> Target -> Cond -> UniqSM (Int, [Instr])
    long_zero_jump Operand
    op Target
    t Cond
    EQ
            CBNZ Operand
    op Target
    t -> Operand -> Target -> Cond -> UniqSM (Int, [Instr])
    long_zero_jump Operand
    op Target
    t Cond
    NE
            Instr
    instr
              | Instr -> Bool
    isMetaInstr Instr
    instr -> (Int, [Instr]) -> UniqSM (Int, [Instr])
    forall a. a -> UniqSM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    pos,[Instr
    instr])
              | Bool
    otherwise -> (Int, [Instr]) -> UniqSM (Int, [Instr])
    forall a. a -> UniqSM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    posInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1, [Instr
    instr])

          where
            -- cmp_op: EQ = CBZ, NEQ = CBNZ
            long_zero_jump :: Operand -> Target -> Cond -> UniqSM (Int, [Instr])
    long_zero_jump Operand
    op Target
    t Cond
    cmp_op =
              case LabelMap Int -> Target -> Int -> BlockInRange
    target_in_range LabelMap Int
    m Target
    t Int
    pos of
                  BlockInRange
    InRange -> (Int, [Instr]) -> UniqSM (Int, [Instr])
    forall a. a -> UniqSM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    posInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    long_bz_jump_size,[Instr
    instr])
                  NotInRange Target
    far_target -> do
                    jmp_code <- Cond -> Target -> UniqSM (OrdList Instr)
    forall (m :: * -> *).
    MonadUnique m =>
    Cond -> Target -> m (OrdList Instr)
    genCondFarJump Cond
    cmp_op Target
    far_target
                    -- TODO: Fix zero reg so we can use it here
                    pure (pos + long_bz_jump_size, CMP op (OpImm (ImmInt 0)) : fromOL jmp_code)

        target_in_range :: LabelMap Int -> Target -> Int -> BlockInRange
        target_in_range :: LabelMap Int -> Target -> Int -> BlockInRange
    target_in_range LabelMap Int
    m Target
    target Int
    src =
          case Target
    target of
            (TReg{}) -> BlockInRange
    InRange
            (TBlock BlockId
    bid) -> LabelMap Int -> Int -> BlockId -> BlockInRange
    block_in_range LabelMap Int
    m Int
    src BlockId
    bid
            (TLabel CLabel
    clbl)
              | Just BlockId
    bid <- CLabel -> Maybe BlockId
    maybeLocalBlockLabel CLabel
    clbl
              -> LabelMap Int -> Int -> BlockId -> BlockInRange
    block_in_range LabelMap Int
    m Int
    src BlockId
    bid
              | Bool
    otherwise
              -- Maybe we should be pessimistic here, for now just fixing intra proc jumps
              -> BlockInRange
    InRange

        block_in_range :: LabelMap Int -> Int -> BlockId -> BlockInRange
        block_in_range :: LabelMap Int -> Int -> BlockId -> BlockInRange
    block_in_range LabelMap Int
    m Int
    src_pos BlockId
    dest_lbl =
          case BlockId -> LabelMap Int -> Maybe Int
    forall a. BlockId -> LabelMap a -> Maybe a
    mapLookup BlockId
    dest_lbl LabelMap Int
    m of
            Maybe Int
    Nothing       ->
              String -> SDoc -> BlockInRange -> BlockInRange
    forall a. String -> SDoc -> a -> a
    pprTrace String
    "not in range" (BlockId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr BlockId
    dest_lbl) (BlockInRange -> BlockInRange) -> BlockInRange -> BlockInRange
    forall a b. (a -> b) -> a -> b
    $
                Target -> BlockInRange
    NotInRange (BlockId -> Target
    TBlock BlockId
    dest_lbl)
            Just Int
    dest_pos -> if Int -> Int
    forall a. Num a => a -> a
    abs (Int
    dest_pos Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    src_pos) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    max_jump_dist
              then BlockInRange
    InRange
              else Target -> BlockInRange
    NotInRange (BlockId -> Target
    TBlock BlockId
    dest_lbl)

        calc_lbl_positions :: (Int, LabelMap Int) -> GenBasicBlock Instr -> (Int, LabelMap Int)
        calc_lbl_positions :: (Int, LabelMap Int) -> NatBasicBlock Instr -> (Int, LabelMap Int)
    calc_lbl_positions (Int
    pos, LabelMap Int
    m) (BasicBlock BlockId
    lbl [Instr]
    instrs)
          = let !pos' :: Int
    pos' = Int
    pos Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + BlockId -> Int
    infoTblSize_maybe BlockId
    lbl
            in ((Int, LabelMap Int) -> Instr -> (Int, LabelMap Int))
    -> (Int, LabelMap Int) -> [Instr] -> (Int, LabelMap Int)
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (Int, LabelMap Int) -> Instr -> (Int, LabelMap Int)
    instr_pos (Int
    pos',BlockId -> Int -> LabelMap Int -> LabelMap Int
    forall v. BlockId -> v -> LabelMap v -> LabelMap v
    mapInsert BlockId
    lbl Int
    pos' LabelMap Int
    m) [Instr]
    instrs

        instr_pos :: (Int, LabelMap Int) -> Instr -> (Int, LabelMap Int)
        instr_pos :: (Int, LabelMap Int) -> Instr -> (Int, LabelMap Int)
    instr_pos (Int
    pos, LabelMap Int
    m) Instr
    instr =
          case Instr
    instr of
            ANN SDoc
    _ann Instr
    instr -> (Int, LabelMap Int) -> Instr -> (Int, LabelMap Int)
    instr_pos (Int
    pos, LabelMap Int
    m) Instr
    instr
            NEWBLOCK BlockId
    _bid -> String -> (Int, LabelMap Int)
    forall a. HasCallStack => String -> a
    panic String
    "mkFarBranched - unexpected NEWBLOCK" -- At this point there should be no NEWBLOCK
                                                                         -- in the instruction stream
                                                                         -- (pos, mapInsert bid pos m)
            COMMENT{} -> (Int
    pos, LabelMap Int
    m)
            Instr
    instr
              | Just Int
    jump_size <- Instr -> Maybe Int
    is_expandable_jump Instr
    instr -> (Int
    posInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    jump_size, LabelMap Int
    m)
              | Bool
    otherwise -> (Int
    posInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1, LabelMap Int
    m)

        infoTblSize_maybe :: BlockId -> Int
    infoTblSize_maybe BlockId
    bid =
          case BlockId -> LabelMap RawCmmStatics -> Maybe RawCmmStatics
    forall a. BlockId -> LabelMap a -> Maybe a
    mapLookup BlockId
    bid LabelMap RawCmmStatics
    statics of
            Maybe RawCmmStatics
    Nothing           -> Int
    0 :: Int
            Just RawCmmStatics
    _info_static -> Int
    max_info_size

        -- These jumps have a 19bit immediate as offset which is quite
        -- limiting so we potentially have to expand them into
        -- multiple instructions.
        is_expandable_jump :: Instr -> Maybe Int
    is_expandable_jump Instr
    i = case Instr
    i of
          CBZ{}   -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    long_bz_jump_size
          CBNZ{}  -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    long_bz_jump_size
          BCOND{} -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    long_bc_jump_size
          Instr
    _ -> Maybe Int
    forall a. Maybe a
    Nothing