    {-# language GADTs #-}
    {-# LANGUAGE TupleSections #-}
    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE BinaryLiterals #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE NumericUnderscores #-}
    module GHC.CmmToAsm.AArch64.CodeGen (
          cmmTopCodeGen
        , generateJumpTableForInstr
    )

    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
       )
    -- 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.Graph
    import GHC.Types.Tickish ( GenTickish(..) )
    import GHC.Types.SrcLoc  ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )

    -- 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

    -- 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
      ([[NatBasicBlock Instr]]
    nat_blocks,[[NatCmmDecl RawCmmStatics Instr]]
    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
      Maybe Reg
    picBaseMb <- NatM (Maybe Reg)
    getPicBaseMaybeNat

      let proc :: NatCmmDecl RawCmmStatics Instr
    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]
    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 Maybe Reg
    picBaseMb of
          Just Reg
    _picBase -> String -> NatM [NatCmmDecl RawCmmStatics Instr]
    forall a. 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
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      -- do
      --   traceM $ "-- --------------------------- basicBlockCodeGen --------------------------- --\n"
      --         ++ showSDocUnsafe (ppr block)
      let (CmmNode C O
    _, Block CmmNode O O
    nodes, CmmNode O C
    tail)  = Block CmmNode C C -> (CmmNode C O, Block CmmNode O O, CmmNode O C)
    forall (n :: Extensibility -> Extensibility -> *).
    Block n C C -> (n C O, Block n O O, n O C)
    blockSplit Block CmmNode C C
    block
          id :: Label
    id = Block CmmNode C C -> Label
    forall (x :: Extensibility). Block CmmNode C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel Block CmmNode C C
    block
          stmts :: [CmmNode O O]
    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 :: OrdList Instr
    header_comment_instr = 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
    text String
    "-- --------------------------- basicBlockCodeGen --------------------------- --\n"
              SDoc -> SDoc -> SDoc
    $+$ 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
              )
      -- Generate location directive
      Maybe DebugBlock
    dbg <- Label -> NatM (Maybe DebugBlock)
    getDebugBlock (Block CmmNode C C -> Label
    forall (x :: Extensibility). Block CmmNode C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel Block CmmNode C C
    block)
      OrdList Instr
    loc_instrs <- case DebugBlock -> Maybe CmmTickish
    dblSourceTick (DebugBlock -> Maybe CmmTickish)
    -> Maybe DebugBlock -> Maybe CmmTickish
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Maybe DebugBlock
    dbg of
        Just (SourceNote RealSrcSpan
    span String
    name)
          -> do Int
    fileId <- FastString -> NatM Int
    getFileId (RealSrcSpan -> FastString
    srcSpanFile RealSrcSpan
    span)
                let line :: Int
    line = RealSrcSpan -> Int
    srcSpanStartLine RealSrcSpan
    span; col :: Int
    col = RealSrcSpan -> Int
    srcSpanStartCol RealSrcSpan
    span
                OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int -> String -> Instr
    LOCATION Int
    fileId Int
    line Int
    col String
    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
      (OrdList Instr
    mid_instrs,Label
    mid_bid) <- Label -> [CmmNode O O] -> NatM (OrdList Instr, Label)
    stmtsToInstrs Label
    id [CmmNode O O]
    stmts
      (!OrdList Instr
    tail_instrs,Maybe Label
    _) <- Label -> CmmNode O C -> NatM (OrdList Instr, Maybe Label)
    forall (e :: Extensibility) (x :: Extensibility).
    Label -> CmmNode e x -> NatM (OrdList Instr, Maybe Label)
    stmtToInstrs Label
    mid_bid CmmNode O C
    tail
      let instrs :: OrdList Instr
    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 extract
      -- LDATAs here too.
      let
            ([Instr]
    top,[NatBasicBlock Instr]
    other_blocks,[NatCmmDecl RawCmmStatics Instr]
    statics) = (Instr
     -> ([Instr], [NatBasicBlock Instr],
         [NatCmmDecl RawCmmStatics Instr])
     -> ([Instr], [NatBasicBlock Instr],
         [NatCmmDecl RawCmmStatics Instr]))
    -> ([Instr], [NatBasicBlock Instr],
        [NatCmmDecl RawCmmStatics Instr])
    -> OrdList Instr
    -> ([Instr], [NatBasicBlock Instr],
        [NatCmmDecl RawCmmStatics Instr])
    forall a b. (a -> b -> b) -> b -> OrdList a -> b
    foldrOL Instr
    -> ([Instr], [NatBasicBlock Instr],
        [NatCmmDecl RawCmmStatics Instr])
    -> ([Instr], [NatBasicBlock Instr],
        [NatCmmDecl RawCmmStatics Instr])
    forall {h} {g}.
    Instr
    -> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
    -> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
    mkBlocks ([],[],[]) OrdList Instr
    instrs

            mkBlocks :: Instr
    -> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
    -> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
    mkBlocks (NEWBLOCK Label
    id) ([Instr]
    instrs,[NatBasicBlock Instr]
    blocks,[GenCmmDecl RawCmmStatics h g]
    statics)
              = ([], Label -> [Instr] -> NatBasicBlock Instr
    forall i. Label -> [i] -> GenBasicBlock i
    BasicBlock Label
    id [Instr]
    instrs NatBasicBlock Instr
    -> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
    forall a. a -> [a] -> [a]
    : [NatBasicBlock Instr]
    blocks, [GenCmmDecl RawCmmStatics h g]
    statics)
            mkBlocks (LDATA Section
    sec RawCmmStatics
    dat) ([Instr]
    instrs,[NatBasicBlock Instr]
    blocks,[GenCmmDecl RawCmmStatics h g]
    statics)
              = ([Instr]
    instrs, [NatBasicBlock Instr]
    blocks, Section -> RawCmmStatics -> GenCmmDecl RawCmmStatics h g
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData Section
    sec RawCmmStatics
    datGenCmmDecl RawCmmStatics h g
    -> [GenCmmDecl RawCmmStatics h g] -> [GenCmmDecl RawCmmStatics h g]
    forall a. a -> [a] -> [a]
    :[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)
      ([NatBasicBlock Instr], [NatCmmDecl RawCmmStatics Instr])
    -> NatM ([NatBasicBlock Instr], [NatCmmDecl RawCmmStatics Instr])
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Label -> [Instr] -> NatBasicBlock Instr
    forall i. Label -> [i] -> GenBasicBlock i
    BasicBlock Label
    id [Instr]
    top NatBasicBlock Instr
    -> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
    forall a. a -> [a] -> [a]
    : [NatBasicBlock Instr]
    other_blocks, [NatCmmDecl RawCmmStatics Instr]
    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 assmebly we see.  By having the verbatim AST printed
    -- we can simply check the patterns that were matched to arrive at the assmebly
    -- 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 labourous and adds
    -- indirections to find the matches that lead to the assembly.
    --
    -- An improvement oculd 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
    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
    reg, Format
    format, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr
      let w :: Width
    w = Format -> Width
    formatToWidth Format
    format
      let mkbranch :: OrdList Instr -> (Integer, Label) -> NatM (OrdList Instr)
    mkbranch OrdList Instr
    acc (Integer
    key, Label
    bid) = do
            (Reg
    keyReg, Format
    _format, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg (CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt Integer
    key Width
    w))
            OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    code 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 (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    keyReg)
                          , Cond -> Target -> Instr
    BCOND Cond
    EQ (Label -> Target
    TBlock Label
    bid)
                          ] OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    acc
          def_code :: OrdList Instr
    def_code = case SwitchTargets -> Maybe Label
    switchTargetsDefault SwitchTargets
    targets of
            Just Label
    bid -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Target -> Instr
    B (Label -> Target
    TBlock Label
    bid))
            Maybe Label
    Nothing  -> OrdList Instr
    forall a. OrdList a
    nilOL

      OrdList Instr
    switch_code <- (OrdList Instr -> (Integer, Label) -> NatM (OrdList Instr))
    -> OrdList Instr -> [(Integer, Label)] -> NatM (OrdList Instr)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM OrdList Instr -> (Integer, Label) -> NatM (OrdList Instr)
    mkbranch OrdList Instr
    forall a. OrdList a
    nilOL (SwitchTargets -> [(Integer, Label)]
    switchTargetsCases SwitchTargets
    targets)
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    switch_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    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 :: Label -> [CmmNode O O] -> NatM (OrdList Instr, Label)
    stmtsToInstrs Label
    bid [CmmNode O O]
    stmts =
        Label
    -> [CmmNode O O] -> OrdList Instr -> NatM (OrdList Instr, Label)
    forall {e :: Extensibility} {x :: Extensibility}.
    Label
    -> [CmmNode e x] -> OrdList Instr -> NatM (OrdList Instr, Label)
    go Label
    bid [CmmNode O O]
    stmts OrdList Instr
    forall a. OrdList a
    nilOL
      where
        go :: Label
    -> [CmmNode e x] -> OrdList Instr -> NatM (OrdList Instr, Label)
    go Label
    bid  []        OrdList Instr
    instrs = (OrdList Instr, Label) -> NatM (OrdList Instr, Label)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    instrs,Label
    bid)
        go Label
    bid (CmmNode e x
    s:[CmmNode e x]
    stmts)  OrdList Instr
    instrs = do
          (OrdList Instr
    instrs',Maybe Label
    bid') <- Label -> CmmNode e x -> NatM (OrdList Instr, Maybe Label)
    forall (e :: Extensibility) (x :: Extensibility).
    Label -> CmmNode e x -> NatM (OrdList Instr, Maybe Label)
    stmtToInstrs Label
    bid CmmNode e x
    s
          -- If the statement introduced a new block, we use that one
          let !newBid :: Label
    newBid = Label -> Maybe Label -> Label
    forall a. a -> Maybe a -> a
    fromMaybe Label
    bid Maybe Label
    bid'
          Label
    -> [CmmNode e x] -> OrdList Instr -> NatM (OrdList Instr, Label)
    go Label
    newBid [CmmNode e x]
    stmts (OrdList Instr
    instrs OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    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).
    Label -> CmmNode e x -> NatM (OrdList Instr, Maybe Label)
    stmtToInstrs Label
    bid CmmNode e x
    stmt = do
      -- traceM $ "-- -------------------------- stmtToInstrs -------------------------- --\n"
      --     ++ showSDocUnsafe (ppr stmt)
      Platform
    platform <- NatM Platform
    getPlatform
      case CmmNode e x
    stmt of
        CmmUnsafeForeignCall ForeignTarget
    target [CmmFormal]
    result_regs [CmmExpr]
    args
           -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> Label
    -> NatM (OrdList Instr, Maybe Label)
    genCCall ForeignTarget
    target [CmmFormal]
    result_regs [CmmExpr]
    args Label
    bid

        CmmNode e x
    _ -> (,Maybe Label
    forall a. Maybe a
    Nothing) (OrdList Instr -> (OrdList Instr, Maybe Label))
    -> NatM (OrdList Instr) -> NatM (OrdList Instr, Maybe Label)
    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
    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 = Platform -> CmmReg -> CmmType
    cmmRegType Platform
    platform 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 Label
    id          -> Label -> NatM (OrdList Instr)
    genBranch Label
    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 Label
    true Label
    false Maybe Bool
    _prediction ->
              Label -> Label -> Label -> CmmExpr -> NatM (OrdList Instr)
    genCondBranch Label
    bid Label
    true Label
    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 GlobalReg
    mid)
      = 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
    $ GlobalReg -> CmmReg
    CmmGlobal GlobalReg
    mid)
            -- 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
      Register
    r <- CmmExpr -> NatM Register
    getRegister CmmExpr
    expr
      case Register
    r of
        Any Format
    rep Reg -> OrdList Instr
    code -> do
            Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    rep
            (Reg, Format, OrdList Instr) -> NatM (Reg, Format, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    tmp, Format
    rep, Reg -> OrdList Instr
    code Reg
    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)

    -- 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
      Register
    r <- CmmExpr -> NatM Register
    getRegister CmmExpr
    expr
      case Register
    r of
        Any Format
    rep Reg -> OrdList Instr
    code | Format -> Bool
    isFloatFormat Format
    rep -> do
          Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    rep
          (Reg, Format, OrdList Instr) -> NatM (Reg, Format, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    tmp, Format
    rep, Reg -> OrdList Instr
    code Reg
    tmp)
        Any Format
    II32 Reg -> OrdList Instr
    code -> do
          Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    FF32
          (Reg, Format, OrdList Instr) -> NatM (Reg, Format, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    tmp, Format
    FF32, Reg -> OrdList Instr
    code Reg
    tmp)
        Any Format
    II64 Reg -> OrdList Instr
    code -> do
          Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    FF64
          (Reg, Format, OrdList Instr) -> NatM (Reg, Format, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    tmp, Format
    FF64, Reg -> OrdList Instr
    code Reg
    tmp)
        Any Format
    _w Reg -> OrdList Instr
    _code -> do
          NCGConfig
    config <- NatM NCGConfig
    getConfig
          String -> SDoc -> NatM (Reg, Format, OrdList Instr)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "can't do getFloatReg on" (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc (NCGConfig -> Platform
    ncgPlatform NCGConfig
    config) CmmExpr
    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
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config (NCGConfig -> Platform
    ncgPlatform NCGConfig
    config) CmmExpr
    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
    text String
    "Unsupported width" SDoc -> SDoc -> SDoc
    <+> 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 GlobalReg
    PicBaseReg)
          -> 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

            -- TODO handle CmmInt 0 specially, use wzr or xzr.

            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 | 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
              (Operand
    op, OrdList Instr
    imm_code) <- CmmLit -> NatM (Operand, OrdList Instr)
    litToImm' CmmLit
    lit
              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
    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
              (Operand
    op, OrdList Instr
    imm_code) <- CmmLit -> NatM (Operand, OrdList Instr)
    litToImm' CmmLit
    lit
              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
    floatFormat Width
    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)
              Reg
    tmp <- Format -> NatM Reg
    getNewRegNat (Width -> Format
    intFormat Width
    W32)
              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
    floatFormat 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
    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)
              Reg
    tmp <- Format -> NatM Reg
    getNewRegNat (Width -> Format
    intFormat Width
    W64)
              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
    floatFormat 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
    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
              (Operand
    op, OrdList Instr
    imm_code) <- CmmLit -> NatM (Operand, OrdList Instr)
    litToImm' CmmLit
    lit
              let rep :: CmmType
    rep = Platform -> CmmLit -> CmmType
    cmmLitType Platform
    plat CmmLit
    lit
                  format :: Format
    format = CmmType -> Format
    cmmTypeFormat CmmType
    rep
              Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    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
              (Operand
    op, OrdList Instr
    imm_code) <- CmmLit -> NatM (Operand, OrdList Instr)
    litToImm' CmmLit
    lit
              let rep :: CmmType
    rep = Platform -> CmmLit -> CmmType
    cmmLitType Platform
    plat CmmLit
    lit
                  format :: Format
    format = CmmType -> Format
    cmmTypeFormat CmmType
    rep
                  -- width = typeWidth rep
              Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    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
              (Operand
    op, OrdList Instr
    imm_code) <- CmmLit -> NatM (Operand, OrdList Instr)
    litToImm' (CLabel -> CmmLit
    CmmLabel CLabel
    lbl)
              let rep :: CmmType
    rep = Platform -> CmmLit -> CmmType
    cmmLitType Platform
    plat CmmLit
    lit
                  format :: Format
    format = CmmType -> Format
    cmmTypeFormat CmmType
    rep
                  width :: Width
    width = CmmType -> Width
    typeWidth CmmType
    rep
              (Reg
    off_r, Format
    _off_format, OrdList Instr
    off_code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg (CmmExpr -> NatM (Reg, Format, OrdList Instr))
    -> CmmExpr -> NatM (Reg, Format, OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    off) Width
    width)
              Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    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 Label
    _ -> 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 AddrMode
    addr OrdList Instr
    addr_code <- Platform -> Width -> CmmExpr -> NatM Amode
    getAmode Platform
    plat (CmmType -> Width
    typeWidth CmmType
    rep) CmmExpr
    mem
          let format :: Format
    format = CmmType -> Format
    cmmTypeFormat CmmType
    rep
          Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    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 (Platform -> CmmReg -> CmmType
    cmmRegType Platform
    plat CmmReg
    reg))
                           (Platform -> CmmReg -> Reg
    getRegisterReg Platform
    plat CmmReg
    reg)
                           OrdList Instr
    forall a. OrdList a
    nilOL)
        CmmRegOff CmmReg
    reg Int
    off | Int -> Integer -> Bool
    isNbitEncodeable Int
    12 (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    off) -> do
          NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    plat (CmmExpr -> NatM Register) -> CmmExpr -> NatM Register
    forall a b. (a -> b) -> a -> b
    $
                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)]
              where width :: Width
    width = CmmType -> Width
    typeWidth (Platform -> CmmReg -> CmmType
    cmmRegType Platform
    plat CmmReg
    reg)

        CmmRegOff CmmReg
    reg Int
    off -> do
          (Reg
    off_r, Format
    _off_format, OrdList Instr
    off_code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg (CmmExpr -> NatM (Reg, Format, OrdList Instr))
    -> CmmExpr -> NatM (Reg, Format, OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    off) Width
    width)
          (Reg
    reg, Format
    _format, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg (CmmExpr -> NatM (Reg, Format, OrdList Instr))
    -> CmmExpr -> NatM (Reg, Format, OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ CmmReg -> CmmExpr
    CmmReg CmmReg
    reg
          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
    width) (\Reg
    dst -> OrdList Instr
    off_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code 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
    reg) (Width -> Reg -> Operand
    OpReg Width
    width Reg
    off_r))
              where width :: Width
    width = CmmType -> Width
    typeWidth (Platform -> CmmReg -> CmmType
    cmmRegType Platform
    plat CmmReg
    reg)

        -- for MachOps, see GHC.Cmm.MachOp
        -- For CmmMachOp, see GHC.Cmm.Expr
        CmmMachOp MachOp
    op [CmmExpr
    e] -> do
          (Reg
    reg, Format
    _format, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    e
          case MachOp
    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
    forall {m :: * -> *}.
    Monad m =>
    OrdList Instr -> Width -> Reg -> m 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 -> m Register
    negate OrdList Instr
    code Width
    w Reg
    reg = do
                let w' :: Width
    w' = Width -> Width
    opRegWidth Width
    w
                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
    w) ((Reg -> OrdList Instr) -> Register)
    -> (Reg -> OrdList Instr) -> Register
    forall a b. (a -> b) -> a -> b
    $ \Reg
    dst ->
                    OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    Width -> Width -> Reg -> OrdList Instr
    signExtendReg Width
    w Width
    w' Reg
    reg 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 GlobalReg
    _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 GlobalReg
    _r)), CmmLit (CmmInt Integer
    0 Width
    _)] -> NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    plat CmmExpr
    expr'
        -- 1. Compute Reg +/- n directly.
        --    For Add/Sub we can directly encode 12bits, or 12bits lsl #12.
        CmmMachOp (MO_Add Width
    w) [(CmmReg CmmReg
    reg), CmmLit (CmmInt Integer
    n Width
    _)]
          | Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    0 Bool -> Bool -> Bool
    && Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    4096 -> 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
    ADD (Width -> Reg -> Operand
    OpReg Width
    w Reg
    d) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    n))))
          -- TODO: 12bits lsl #12; e.g. lower 12 bits of n are 0; shift n >> 12, and set lsl to #12.
          where w' :: Width
    w' = Format -> Width
    formatToWidth (CmmType -> Format
    cmmTypeFormat (Platform -> CmmReg -> CmmType
    cmmRegType Platform
    plat CmmReg
    reg))
                r' :: Reg
    r' = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    plat CmmReg
    reg
        CmmMachOp (MO_Sub Width
    w) [(CmmReg CmmReg
    reg), CmmLit (CmmInt Integer
    n Width
    _)]
          | Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    0 Bool -> Bool -> Bool
    && Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    4096 -> 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
    SUB (Width -> Reg -> Operand
    OpReg Width
    w Reg
    d) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    n))))
          -- TODO: 12bits lsl #12; e.g. lower 12 bits of n are 0; shift n >> 12, and set lsl to #12.
          where w' :: Width
    w' = Format -> Width
    formatToWidth (CmmType -> Format
    cmmTypeFormat (Platform -> CmmReg -> CmmType
    cmmRegType Platform
    plat CmmReg
    reg))
                r' :: Reg
    r' = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    plat CmmReg
    reg

        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
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (Reg
    reg_y, Format
    _format_y, OrdList Instr
    code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    y
          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
    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
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (Reg
    reg_y, Format
    _format_y, OrdList Instr
    code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    y
          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
    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, 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
    32 -> do
          (Reg
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          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
    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_Shl Width
    w) [CmmExpr
    x, (CmmLit (CmmInt Integer
    n Width
    _))] | 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
    < Integer
    64 -> do
          (Reg
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          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
    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
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          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
    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)))))
        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
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (Reg
    reg_y, Format
    _format_y, OrdList Instr
    code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    y
          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
    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)))

        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
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          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
    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)))))
        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
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (Reg
    reg_y, Format
    _format_y, OrdList Instr
    code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    y
          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
    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)))

        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, 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
    32 -> do
          (Reg
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          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
    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_S_Shr Width
    w) [CmmExpr
    x, (CmmLit (CmmInt Integer
    n Width
    _))] | 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
    < Integer
    64 -> do
          (Reg
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          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
    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
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          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
    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
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (Reg
    reg_y, Format
    _format_y, OrdList Instr
    code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    y
          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
    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
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          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
    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
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (Reg
    reg_y, Format
    _format_y, OrdList Instr
    code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    y
          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
    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, 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
    32 -> do
          (Reg
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          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
    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))))

        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
    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
    < Integer
    64 -> do
          (Reg
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          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
    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
    _)] | Integer -> Bool
    isBitMaskImmediate (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 (Platform -> CmmReg -> CmmType
    cmmRegType Platform
    plat 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
    _)] | Integer -> Bool
    isBitMaskImmediate (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 (Platform -> CmmReg -> CmmType
    cmmRegType Platform
    plat CmmReg
    reg))
                r' :: Reg
    r' = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    plat CmmReg
    reg

        -- Generic 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.
              bitOp :: Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    bitOp 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
    reg_x, Format
    format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
                (Reg
    reg_y, Format
    format_y, OrdList Instr
    code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    y
                Bool -> SDoc -> NatM ()
    forall (m :: * -> *).
    (HasCallStack, Applicative m) =>
    Bool -> SDoc -> m ()
    massertPpr (Format -> Bool
    isIntFormat Format
    format_x Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Format -> Bool
    isIntFormat Format
    format_y) (SDoc -> NatM ()) -> SDoc -> NatM ()
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "bitOp: incompatible"
                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
    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) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_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].
              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
    reg_x, Format
    format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
                  (Reg
    reg_y, Format
    format_y, OrdList Instr
    code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    y
                  Bool -> SDoc -> NatM ()
    forall (m :: * -> *).
    (HasCallStack, Applicative m) =>
    Bool -> SDoc -> m ()
    massertPpr (Format -> Bool
    isIntFormat Format
    format_x Bool -> Bool -> Bool
    && Format -> Bool
    isIntFormat Format
    format_y) (SDoc -> NatM ()) -> SDoc -> NatM ()
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "intOp: non-int"
                  -- This is the width of the registers on which the operation
                  -- should be performed.
                  let w' :: Width
    w' = Width -> Width
    opRegWidth Width
    w
                      signExt :: Reg -> OrdList Instr
    signExt Reg
    r
                        | Bool -> Bool
    not Bool
    is_signed  = OrdList Instr
    forall a. OrdList a
    nilOL
                        | Bool
    otherwise      = Width -> Width -> Reg -> OrdList Instr
    signExtendReg Width
    w Width
    w' Reg
    r
                  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 ->
                      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
                      Reg -> OrdList Instr
    signExt Reg
    reg_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                      Reg -> OrdList Instr
    signExt Reg
    reg_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) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    reg_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

              floatOp :: Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    floatOp Width
    w Operand -> Operand -> Operand -> OrdList Instr
    op = do
                (Reg
    reg_fx, Format
    format_x, OrdList Instr
    code_fx) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
    CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getFloatReg CmmExpr
    x
                (Reg
    reg_fy, Format
    format_y, OrdList Instr
    code_fy) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
    CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getFloatReg CmmExpr
    y
                Bool -> SDoc -> NatM ()
    forall (m :: * -> *).
    (HasCallStack, Applicative m) =>
    Bool -> SDoc -> m ()
    massertPpr (Format -> Bool
    isFloatFormat Format
    format_x Bool -> Bool -> Bool
    && Format -> Bool
    isFloatFormat Format
    format_y) (SDoc -> NatM ()) -> SDoc -> NatM ()
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "floatOp: non-float"
                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_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
    reg_fx, Format
    format_x, OrdList Instr
    code_fx) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
    CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getFloatReg CmmExpr
    x
                (Reg
    reg_fy, Format
    format_y, OrdList Instr
    code_fy) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
    CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getFloatReg CmmExpr
    y
                Bool -> SDoc -> NatM ()
    forall (m :: * -> *).
    (HasCallStack, Applicative m) =>
    Bool -> SDoc -> m ()
    massertPpr (Format -> Bool
    isFloatFormat Format
    format_x Bool -> Bool -> Bool
    && Format -> Bool
    isFloatFormat Format
    format_y) (SDoc -> NatM ()) -> SDoc -> NatM ()
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "floatCond: non-float"
                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
    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)
    -> 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
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    ADD Operand
    d Operand
    x Operand
    y))
            -- TODO: Handle sub-word case
            MO_Sub 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
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    SUB Operand
    d Operand
    x Operand
    y))

            -- 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)
    -> NatM Register
    bitOp 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_Ne Width
    w     -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    bitOp 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 ])

            -- 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 -> 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
    MUL Operand
    d Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    VS ])
            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_MulMayOflo Width
    _w -> Platform -> CmmExpr -> NatM Register
    forall env a b. OutputableP env a => env -> a -> b
    unsupportedP Platform
    plat CmmExpr
    expr
            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)
    -> NatM Register
    intOp 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 ])
            MO_U_Le 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
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    ULE ])
            MO_U_Gt 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
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    UGT ])
            MO_U_Lt 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
    toOL [ Operand -> Operand -> Instr
    CMP Operand
    x Operand
    y, Operand -> Cond -> Instr
    CSET Operand
    d Cond
    ULT ])

            -- 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 intutive. 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)
    -> NatM Register
    bitOp 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)
            MO_Or    Width
    w -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    bitOp 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)
            MO_Xor   Width
    w -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    bitOp 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)
            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
    <+> String -> SDoc
    text String
    "in" SDoc -> SDoc -> SDoc
    <+> (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)
        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
        unsupportedP :: OutputableP env a => env -> a -> b
        unsupportedP :: forall env a b. OutputableP env a => env -> a -> b
    unsupportedP env
    platform a
    op = String -> SDoc -> b
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "Unsupported op:" (env -> a -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc env
    platform a
    op)

        isNbitEncodeable :: Int -> Integer -> Bool
        isNbitEncodeable :: Int -> Integer -> Bool
    isNbitEncodeable Int
    n Integer
    i = let shift :: Int
    shift = Int
    n 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)
        -- This needs to check if n can be encoded as a bitmask immediate:
        --
        -- See https://stackoverflow.com/questions/30904718/range-of-immediate-values-in-armv8-a64-assembly
        --
        isBitMaskImmediate :: Integer -> Bool
        isBitMaskImmediate :: Integer -> Bool
    isBitMaskImmediate Integer
    i = Integer
    i Integer -> [Integer] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Integer
    0b0000_0001, Integer
    0b0000_0010, Integer
    0b0000_0100, Integer
    0b0000_1000, Integer
    0b0001_0000, Integer
    0b0010_0000, Integer
    0b0100_0000, Integer
    0b1000_0000
                                        ,Integer
    0b0000_0011, Integer
    0b0000_0110, Integer
    0b0000_1100, Integer
    0b0001_1000, Integer
    0b0011_0000, Integer
    0b0110_0000, Integer
    0b1100_0000
                                        ,Integer
    0b0000_0111, Integer
    0b0000_1110, Integer
    0b0001_1100, Integer
    0b0011_1000, Integer
    0b0111_0000, Integer
    0b1110_0000
                                        ,Integer
    0b0000_1111, Integer
    0b0001_1110, Integer
    0b0011_1100, Integer
    0b0111_1000, Integer
    0b1111_0000
                                        ,Integer
    0b0001_1111, Integer
    0b0011_1110, Integer
    0b0111_1100, Integer
    0b1111_1000
                                        ,Integer
    0b0011_1111, Integer
    0b0111_1110, Integer
    0b1111_1100
                                        ,Integer
    0b0111_1111, Integer
    0b1111_1110
                                        ,Integer
    0b1111_1111]

    -- | Instructions to sign-extend the value in the given register from width @w@
    -- up to width @w'@.
    signExtendReg :: Width -> Width -> Reg -> OrdList Instr
    signExtendReg :: Width -> Width -> Reg -> OrdList Instr
    signExtendReg 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
            | Bool
    otherwise -> 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
    SXTH (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r)
          Width
    W16           -> 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
    SXTH (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r)
          Width
    W8            -> 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
    SXTB (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r)
          Width
    _             -> String -> OrdList Instr
    forall a. String -> a
    panic String
    "intOp"

    -- | 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:
    -- LDUR/STUR: imm9: -256 - 255
    getAmode :: Platform -> Width -> CmmExpr -> NatM Amode
    getAmode Platform
    platform Width
    _ (CmmRegOff CmmReg
    reg Int
    off) | -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
      = 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
    -- LDR/STR: imm12: if reg is 32bit: 0 -- 16380 in multiples of 4
    getAmode Platform
    platform Width
    W32 (CmmRegOff CmmReg
    reg Int
    off)
      | 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
    16380, Int
    off Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    4 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0
      = 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
    -- LDR/STR: imm12: if reg is 64bit: 0 -- 32760 in multiples of 8
    getAmode Platform
    platform Width
    W64 (CmmRegOff CmmReg
    reg Int
    off)
      | 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
    32760, Int
    off 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
      = 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
    _ (CmmMachOp (MO_Add Width
    _w) [CmmExpr
    expr, CmmLit (CmmInt Integer
    off Width
    _w')])
      | -Integer
    256 Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    off, Integer
    off Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    255
      = do (Reg
    reg, Format
    _format, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr
           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 (Integer -> Imm
    ImmInteger Integer
    off)) OrdList Instr
    code

    getAmode Platform
    _platform Width
    _ (CmmMachOp (MO_Sub Width
    _w) [CmmExpr
    expr, CmmLit (CmmInt Integer
    off Width
    _w')])
      | -Integer
    256 Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= -Integer
    off, -Integer
    off Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    255
      = do (Reg
    reg, Format
    _format, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr
           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 (Integer -> Imm
    ImmInteger (-Integer
    off))) OrdList Instr
    code

    -- Generic case
    getAmode Platform
    _platform Width
    _ CmmExpr
    expr
      = do (Reg
    reg, Format
    _format, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr
           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 -> AddrMode
    AddrReg Reg
    reg) OrdList Instr
    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
        (Reg
    src_reg, Format
    _format, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    srcE
        Platform
    platform <- NatM Platform
    getPlatform
        let w :: Width
    w = Format -> Width
    formatToWidth Format
    rep
        Amode AddrMode
    addr OrdList Instr
    addr_code <- Platform -> Width -> CmmExpr -> NatM Amode
    getAmode Platform
    platform Width
    w CmmExpr
    addrE
        OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ SDoc -> Instr
    COMMENT (String -> SDoc
    text String
    "CmmStore" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens (String -> SDoc
    text (CmmExpr -> String
    forall a. Show a => a -> String
    show CmmExpr
    addrE)) SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens (String -> SDoc
    text (CmmExpr -> String
    forall a. Show a => a -> String
    show CmmExpr
    srcE)))
                Instr -> OrdList Instr -> OrdList Instr
    forall a. a -> OrdList a -> OrdList a
    `consOL` (OrdList Instr
    code
                OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    addr_code
                OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Operand -> Operand -> Instr
    STR Format
    rep (Width -> Reg -> Operand
    OpReg Width
    w Reg
    src_reg) (AddrMode -> Operand
    OpAddr AddrMode
    addr))

    assignReg_IntCode :: Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_IntCode Format
    _ CmmReg
    reg CmmExpr
    src
      = do
        Platform
    platform <- NatM Platform
    getPlatform
        let dst :: Reg
    dst = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform CmmReg
    reg
        Register
    r <- CmmExpr -> NatM Register
    getRegister CmmExpr
    src
        OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ case Register
    r of
          Any Format
    _ Reg -> OrdList Instr
    code              -> SDoc -> Instr
    COMMENT (String -> SDoc
    text String
    "CmmAssign" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens (String -> SDoc
    text (CmmReg -> String
    forall a. Show a => a -> String
    show CmmReg
    reg)) SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens (String -> SDoc
    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
    text String
    "CmmAssign" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens (String -> SDoc
    text (CmmReg -> String
    forall a. Show a => a -> String
    show CmmReg
    reg)) SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens (String -> SDoc
    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))
      = OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Target -> Instr
    J (CLabel -> Target
    TLabel CLabel
    lbl)))

    genJump CmmExpr
    expr = do
        (Reg
    target, Format
    _format, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr
        OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Target -> Instr
    J (Reg -> Target
    TReg Reg
    target))))

    -- -----------------------------------------------------------------------------
    --  Unconditional branches
    genBranch :: BlockId -> NatM InstrBlock
    genBranch :: Label -> 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))
    -> (Label -> OrdList Instr) -> Label -> 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)
    -> (Label -> [Instr]) -> Label -> OrdList Instr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Label -> [Instr]
    mkJumpInstr

    -- -----------------------------------------------------------------------------
    -- Conditional branches
    genCondJump
        :: BlockId
        -> CmmExpr
        -> NatM InstrBlock
    genCondJump :: Label -> CmmExpr -> NatM (OrdList Instr)
    genCondJump Label
    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
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
            OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    code_x OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` (CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Target -> Instr
    CBZ (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Label -> Target
    TBlock Label
    bid)))

          -- Optimized /= 0 case.
          CmmMachOp (MO_Ne Width
    w) [CmmExpr
    x, CmmLit (CmmInt Integer
    0 Width
    _)] -> do
            (Reg
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
            OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    code_x OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`  (CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Target -> Instr
    CBNZ (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Label -> Target
    TBlock Label
    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
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
                    (Reg
    reg_y, Format
    _format_y, OrdList Instr
    code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    y
                    let x' :: Operand
    x' = Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x
                        y' :: Operand
    y' = Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y
                    OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ case Width
    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 (Label -> Target
    TBlock Label
    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 (Label -> Target
    TBlock Label
    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 (Label -> Target
    TBlock Label
    bid))) ]

                sbcond :: Width -> Cond -> NatM (OrdList Instr)
    sbcond Width
    w Cond
    cmp = do
                    -- compute both sides.
                    (Reg
    reg_x, Format
    _format_x, OrdList Instr
    code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
                    (Reg
    reg_y, Format
    _format_y, OrdList Instr
    code_y) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    y
                    let x' :: Operand
    x' = Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x
                        y' :: Operand
    y' = Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y
                    OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ case Width
    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 (Label -> Target
    TBlock Label
    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 (Label -> Target
    TBlock Label
    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 (Label -> Target
    TBlock Label
    bid))) ]

                fbcond :: Width -> Cond -> NatM (OrdList Instr)
    fbcond Width
    w Cond
    cmp = do
                  -- ensure we get float regs
                  (Reg
    reg_fx, Format
    _format_fx, OrdList Instr
    code_fx) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
    CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getFloatReg CmmExpr
    x
                  (Reg
    reg_fy, Format
    _format_fy, OrdList Instr
    code_fy) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
    CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getFloatReg CmmExpr
    y
                  OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ 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 -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Operand -> Operand -> Instr
    CMP (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_fx) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_fy) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` (CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Cond -> Target -> Instr
    BCOND Cond
    cmp (Label -> Target
    TBlock Label
    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
    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
    text (String -> SDoc) -> String -> SDoc
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> String
    forall a. Show a => a -> String
    show CmmExpr
    expr)

    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 :: Label -> Label -> Label -> CmmExpr -> NatM (OrdList Instr)
    genCondBranch Label
    _ Label
    true Label
    false CmmExpr
    expr = do
      OrdList Instr
    b1 <- Label -> CmmExpr -> NatM (OrdList Instr)
    genCondJump Label
    true CmmExpr
    expr
      OrdList Instr
    b2 <- Label -> NatM (OrdList Instr)
    genBranch Label
    false
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    b1 OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    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]
    -> Label
    -> NatM (OrdList Instr, Maybe Label)
    genCCall ForeignTarget
    target [CmmFormal]
    dest_regs [CmmExpr]
    arg_regs Label
    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)

      case ForeignTarget
    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
          (Target
    call_target, OrdList Instr
    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
    reg, Format
    _format, OrdList Instr
    reg_code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr
                    (Target, OrdList Instr) -> NatM (Target, OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Reg -> Target
    TReg Reg
    reg, OrdList Instr
    reg_code)
          -- compute the code and register logic for all arg_regs.
          -- this will give us the format information to match on.
          [(Reg, Format, OrdList Instr)]
    arg_regs' <- (CmmExpr -> NatM (Reg, Format, OrdList Instr))
    -> [CmmExpr] -> NatM [(Reg, Format, OrdList Instr)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg [CmmExpr]
    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 ([ForeignHint]
    _res_hints, [ForeignHint]
    arg_hints) = ForeignTarget -> ([ForeignHint], [ForeignHint])
    foreignTargetHints ForeignTarget
    target
              arg_regs'' :: [(Reg, Format, ForeignHint, OrdList Instr)]
    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

          Platform
    platform <- NatM Platform
    getPlatform
          let packStack :: Bool
    packStack = Platform -> OS
    platformOS Platform
    platform OS -> OS -> Bool
    forall a. Eq a => a -> a -> Bool
    == OS
    OSDarwin

          (Int
    stackSpace', [Reg]
    passRegs, OrdList Instr
    passArgumentsCode) <- Bool
    -> [Reg]
    -> [Reg]
    -> [(Reg, Format, ForeignHint, OrdList Instr)]
    -> Int
    -> [Reg]
    -> OrdList Instr
    -> NatM (Int, [Reg], OrdList Instr)
    passArguments Bool
    packStack [Reg]
    allGpArgRegs [Reg]
    allFpArgRegs [(Reg, Format, ForeignHint, OrdList Instr)]
    arg_regs'' Int
    0 [] OrdList Instr
    forall a. OrdList a
    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 :: Int
    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'

          ([Reg]
    returnRegs, OrdList Instr
    readResultsCode)   <- [Reg]
    -> [Reg]
    -> [CmmFormal]
    -> [Reg]
    -> OrdList Instr
    -> NatM ([Reg], OrdList Instr)
    readResults [Reg]
    allGpArgRegs [Reg]
    allFpArgRegs [CmmFormal]
    dest_regs [] OrdList Instr
    forall a. OrdList a
    nilOL

          let moveStackDown :: Int -> OrdList Instr
    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 -> OrdList Instr
    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
    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] -> [Reg] -> Instr
    BL Target
    call_target [Reg]
    passRegs [Reg]
    returnRegs) -- 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)
          (OrdList Instr, Maybe Label) -> NatM (OrdList Instr, Maybe Label)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    code, Maybe Label
    forall a. Maybe a
    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 Label)
    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
        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 Label)
    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

        -- 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 Label)
    mkCCall FastString
    "pow"

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

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

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

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

            CallishMachOp
    MO_F64_Log   -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall FastString
    "log"
            CallishMachOp
    MO_F64_Log1P -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall FastString
    "log1p"
            CallishMachOp
    MO_F64_Exp   -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall FastString
    "exp"
            CallishMachOp
    MO_F64_ExpM1 -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall FastString
    "expm1"
            CallishMachOp
    MO_F64_Fabs  -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall FastString
    "fabs"
            CallishMachOp
    MO_F64_Sqrt  -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall FastString
    "sqrt"

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

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

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

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

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

            -- Memory Ordering
            -- TODO DMBSY is probably *way* too much!
            CallishMachOp
    MO_ReadBarrier      ->  (OrdList Instr, Maybe Label) -> NatM (OrdList Instr, Maybe Label)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL Instr
    DMBSY, Maybe Label
    forall a. Maybe a
    Nothing)
            CallishMachOp
    MO_WriteBarrier     ->  (OrdList Instr, Maybe Label) -> NatM (OrdList Instr, Maybe Label)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL Instr
    DMBSY, Maybe Label
    forall a. Maybe a
    Nothing)
            CallishMachOp
    MO_Touch            ->  (OrdList Instr, Maybe Label) -> NatM (OrdList Instr, Maybe Label)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    forall a. OrdList a
    nilOL, Maybe Label
    forall a. Maybe a
    Nothing) -- Keep variables live (when using interior pointers)
            -- Prefetch
            MO_Prefetch_Data Int
    _n -> (OrdList Instr, Maybe Label) -> NatM (OrdList Instr, Maybe Label)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    forall a. OrdList a
    nilOL, Maybe Label
    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 Label)
    mkCCall FastString
    "memcpy"
            MO_Memset  Int
    _align   -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall FastString
    "memset"
            MO_Memmove Int
    _align   -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall FastString
    "memmove"
            MO_Memcmp  Int
    _align   -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall FastString
    "memcmp"

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

            MO_PopCnt Width
    w         -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall (Width -> FastString
    popCntLabel Width
    w)
            MO_Pdep Width
    w           -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall (Width -> FastString
    pdepLabel Width
    w)
            MO_Pext Width
    w           -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall (Width -> FastString
    pextLabel Width
    w)
            MO_Clz Width
    w            -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall (Width -> FastString
    clzLabel Width
    w)
            MO_Ctz Width
    w            -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall (Width -> FastString
    ctzLabel Width
    w)
            MO_BSwap Width
    w          -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall (Width -> FastString
    bSwapLabel Width
    w)
            MO_BRev Width
    w           -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall (Width -> FastString
    bRevLabel Width
    w)

            -- -- Atomic read-modify-write.
            MO_AtomicRMW Width
    w AtomicMachOp
    amop -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall (Width -> AtomicMachOp -> FastString
    atomicRMWLabel Width
    w AtomicMachOp
    amop)
            MO_AtomicRead Width
    w     -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall (Width -> FastString
    atomicReadLabel Width
    w)
            MO_AtomicWrite Width
    w    -> FastString -> NatM (OrdList Instr, Maybe Label)
    mkCCall (Width -> FastString
    atomicWriteLabel Width
    w)
            MO_Cmpxchg Width
    w        -> FastString -> NatM (OrdList Instr, Maybe Label)
    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 Label)
    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. 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 Label)
    mkCCall FastString
    name = do
          NCGConfig
    config <- NatM NCGConfig
    getConfig
          CmmExpr
    target <- NCGConfig -> ReferenceKind -> CLabel -> NatM CmmExpr
    forall (m :: * -> *).
    CmmMakeDynamicReferenceM m =>
    NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
    cmmMakeDynamicReference NCGConfig
    config ReferenceKind
    CallReference (CLabel -> NatM CmmExpr) -> CLabel -> NatM CmmExpr
    forall a b. (a -> b) -> a -> b
    $
              FastString
    -> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
    mkForeignLabel FastString
    name Maybe Int
    forall a. Maybe a
    Nothing ForeignLabelSource
    ForeignLabelInThisPackage FunctionOrData
    IsFunction
          let cconv :: ForeignConvention
    cconv = CCallConv
    -> [ForeignHint]
    -> [ForeignHint]
    -> CmmReturnInfo
    -> ForeignConvention
    ForeignConvention CCallConv
    CCallConv [ForeignHint
    NoHint] [ForeignHint
    NoHint] CmmReturnInfo
    CmmMayReturn
          ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> Label
    -> NatM (OrdList Instr, Maybe Label)
    genCCall (CmmExpr -> ForeignConvention -> ForeignTarget
    ForeignTarget CmmExpr
    target ForeignConvention
    cconv) [CmmFormal]
    dest_regs [CmmExpr]
    arg_regs Label
    bid

        -- TODO: Optimize using paired stores and loads (STP, LDP). It is
        -- automomatically 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
          let w :: Width
    w = Format -> Width
    formatToWidth Format
    format
          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
    gpRegReg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    :[Reg]
    accumRegs) (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
    text String
    "Pass gp argument: " SDoc -> SDoc -> SDoc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r) (Instr -> Instr) -> Instr -> Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    w Reg
    gpReg) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r)))

        -- 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
          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 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
    text String
    "Pass fp argument: " SDoc -> SDoc -> SDoc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r) (Instr -> Instr) -> Instr -> Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    w Reg
    fpReg) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r)))

        -- 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
              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
    text String
    "Pass argument (size " SDoc -> SDoc -> SDoc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    ") on the stack: " SDoc -> SDoc -> SDoc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r) (Instr -> Instr) -> Instr -> Instr
    forall a b. (a -> b) -> a -> b
    $ 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'))))
          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
              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
    text String
    "Pass argument (size " SDoc -> SDoc -> SDoc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    ") on the stack: " SDoc -> SDoc -> SDoc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r) (Instr -> Instr) -> Instr -> Instr
    forall a b. (a -> b) -> a -> b
    $ 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'))))
          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
              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
    text String
    "Pass argument (size " SDoc -> SDoc -> SDoc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    ") on the stack: " SDoc -> SDoc -> SDoc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r) (Instr -> Instr) -> Instr -> Instr
    forall a b. (a -> b) -> a -> b
    $ 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'))))
          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
    text String
    "invalid state")

        readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg]-> InstrBlock -> NatM ([Reg], InstrBlock)
        readResults :: [Reg]
    -> [Reg]
    -> [CmmFormal]
    -> [Reg]
    -> OrdList Instr
    -> NatM ([Reg], OrdList Instr)
    readResults [Reg]
    _ [Reg]
    _ [] [Reg]
    accumRegs OrdList Instr
    accumCode = ([Reg], OrdList Instr) -> NatM ([Reg], OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Reg]
    accumRegs, OrdList Instr
    accumCode)
        readResults [] [Reg]
    _ [CmmFormal]
    _ [Reg]
    _ OrdList Instr
    _ = do
          Platform
    platform <- NatM Platform
    getPlatform
          String -> SDoc -> NatM ([Reg], OrdList Instr)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "genCCall, out of gp registers when reading results" (Platform -> ForeignTarget -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform ForeignTarget
    target)
        readResults [Reg]
    _ [] [CmmFormal]
    _ [Reg]
    _ OrdList Instr
    _ = do
          Platform
    platform <- NatM Platform
    getPlatform
          String -> SDoc -> NatM ([Reg], OrdList Instr)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "genCCall, out of fp registers when reading results" (Platform -> ForeignTarget -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform ForeignTarget
    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
    platform <- NatM Platform
    getPlatform
          let rep :: CmmType
    rep = Platform -> CmmReg -> CmmType
    cmmRegType Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
              format :: Format
    format = CmmType -> Format
    cmmTypeFormat CmmType
    rep
              w :: Width
    w   = Platform -> CmmReg -> Width
    cmmRegWidth Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
              r_dst :: Reg
    r_dst = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
          if Format -> Bool
    isFloatFormat Format
    format
            then [Reg]
    -> [Reg]
    -> [CmmFormal]
    -> [Reg]
    -> OrdList Instr
    -> NatM ([Reg], OrdList Instr)
    readResults (Reg
    gpRegReg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    :[Reg]
    gpRegs) [Reg]
    fpRegs [CmmFormal]
    dsts (Reg
    fpRegReg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    :[Reg]
    accumRegs) (OrdList Instr
    accumCode OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r_dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    fpReg))
            else [Reg]
    -> [Reg]
    -> [CmmFormal]
    -> [Reg]
    -> OrdList Instr
    -> NatM ([Reg], OrdList Instr)
    readResults [Reg]
    gpRegs (Reg
    fpRegReg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    :[Reg]
    fpRegs) [CmmFormal]
    dsts (Reg
    gpRegReg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    :[Reg]
    accumRegs) (OrdList Instr
    accumCode OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r_dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    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
    platform <- NatM Platform
    getPlatform
          (Reg
    reg_fx, Format
    _format_x, OrdList Instr
    code_fx) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
    CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getFloatReg CmmExpr
    arg_reg
          let dst :: Reg
    dst = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dest_reg)
          let code :: OrdList Instr
    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)
          (OrdList Instr, Maybe a) -> NatM (OrdList Instr, Maybe a)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    code, Maybe a
    forall a. Maybe a
    Nothing)