    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE BinaryLiterals #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE OverloadedStrings #-}

    module GHC.CmmToAsm.RV64.CodeGen
      ( cmmTopCodeGen,
        generateJumpTableForInstr,
        makeFarBranches,
      )
    where

    import Control.Monad
    import Data.Maybe
    import Data.Word
    import GHC.Cmm
    import GHC.Cmm.BlockId
    import GHC.Cmm.CLabel
    import GHC.Cmm.Dataflow.Block
    import GHC.Cmm.Dataflow.Graph
    import GHC.Cmm.Dataflow.Label
    import GHC.Cmm.DebugBlock
    import GHC.Cmm.Switch
    import GHC.Cmm.Utils
    import GHC.CmmToAsm.CPrim
    import GHC.CmmToAsm.Config
    import GHC.CmmToAsm.Format
    import GHC.CmmToAsm.Monad
      ( NatM,
        getBlockIdNat,
        getConfig,
        getDebugBlock,
        getFileId,
        getNewLabelNat,
        getNewRegNat,
        getPicBaseMaybeNat,
        getPlatform,
      )
    import GHC.CmmToAsm.PIC
    import GHC.CmmToAsm.RV64.Cond
    import GHC.CmmToAsm.RV64.Instr
    import GHC.CmmToAsm.RV64.Regs
    import GHC.CmmToAsm.Types
    import GHC.Data.FastString
    import GHC.Data.OrdList
    import GHC.Float
    import GHC.Platform
    import GHC.Platform.Reg
    import GHC.Platform.Regs
    import GHC.Prelude hiding (EQ)
    import GHC.Types.Basic
    import GHC.Types.ForeignCall
    import GHC.Types.SrcLoc (srcSpanFile, srcSpanStartCol, srcSpanStartLine)
    import GHC.Types.Tickish (GenTickish (..))
    import GHC.Types.Unique.DSM
    import GHC.Utils.Constants (debugIsOn)
    import GHC.Utils.Misc
    import GHC.Utils.Monad
    import GHC.Utils.Outputable
    import GHC.Utils.Panic

    -- For an overview of an NCG's structure, see Note [General layout of an NCG]

    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 [GlobalRegUse]
    live CmmGraph
    graph) = do
      picBaseMb <- NatM (Maybe Reg)
    getPicBaseMaybeNat
      when (isJust picBaseMb) $ panic "RV64.cmmTopCodeGen: Unexpected PIC base register (RISCV ISA does not define one)"

      let blocks = CmmGraph -> [Block CmmNode C C]
    toBlockListEntryFirst CmmGraph
    graph
      (nat_blocks, statics) <- mapAndUnzipM basicBlockCodeGen blocks

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

      pure tops

    -- ... or CmmData.
    cmmTopCodeGen (CmmData Section
    sec RawCmmStatics
    dat) = [NatCmmDecl RawCmmStatics Instr]
    -> NatM [NatCmmDecl RawCmmStatics Instr]
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Section -> RawCmmStatics -> NatCmmDecl RawCmmStatics Instr
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData Section
    sec RawCmmStatics
    dat] -- no translation, we just use CmmStatic

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

          header_comment_instr
            | Bool
    debugIsOn =
                Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL
                  (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ SDoc -> Instr
    MULTILINE_COMMENT
                    ( [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "-- --------------------------- basicBlockCodeGen --------------------------- --\n"
                        SDoc -> SDoc -> SDoc
    $+$ PprStyle -> SDoc -> SDoc
    withPprStyle PprStyle
    defaultDumpStyle (Platform -> Block CmmNode C C -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc (NCGConfig -> Platform
    ncgPlatform NCGConfig
    config) Block CmmNode C C
    block)
                    )
            | Bool
    otherwise = OrdList Instr
    forall a. OrdList a
    nilOL

      -- Generate location directive `.loc` (DWARF debug location info)
      loc_instrs <- genLocInstrs

      -- Generate other instructions
      mid_instrs <- stmtsToInstrs stmts
      (!tail_instrs) <- stmtToInstrs tail

      let instrs = OrdList Instr
    header_comment_instr OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    loc_instrs OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    mid_instrs OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    tail_instrs

          -- TODO: Then x86 backend runs @verifyBasicBlock@ here. How important it is to
          -- have a valid CFG is an open question: This and the AArch64 and PPC NCGs
          -- work fine without it.

          -- 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.
          (top, other_blocks, statics) = foldrOL mkBlocks ([], [], []) instrs

      return (BasicBlock id top : other_blocks, statics)
      where
        genLocInstrs :: NatM (OrdList Instr)
        genLocInstrs :: NatM (OrdList Instr)
    genLocInstrs = do
          dbg <- BlockId -> NatM (Maybe DebugBlock)
    getDebugBlock (Block CmmNode C C -> BlockId
    forall (x :: Extensibility). Block CmmNode C x -> BlockId
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> BlockId
    entryLabel Block CmmNode C C
    block)
          case dblSourceTick =<< dbg of
            Just (SourceNote RealSrcSpan
    span LexicalFastString
    name) ->
              do
                fileId <- FastString -> NatM Int
    getFileId (RealSrcSpan -> FastString
    srcSpanFile RealSrcSpan
    span)
                let line = RealSrcSpan -> Int
    srcSpanStartLine RealSrcSpan
    span; col = RealSrcSpan -> Int
    srcSpanStartCol RealSrcSpan
    span
                pure $ unitOL $ LOCATION fileId line col name
            Maybe CmmTickish
    _ -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure OrdList Instr
    forall a. OrdList a
    nilOL

    mkBlocks ::
      Instr ->
      ([Instr], [GenBasicBlock Instr], [GenCmmDecl RawCmmStatics h g]) ->
      ([Instr], [GenBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
    mkBlocks :: forall h g.
    Instr
    -> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
    -> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
    mkBlocks (NEWBLOCK BlockId
    id) ([Instr]
    instrs, [NatBasicBlock Instr]
    blocks, [GenCmmDecl RawCmmStatics h g]
    statics) =
      ([], BlockId -> [Instr] -> NatBasicBlock Instr
    forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    id [Instr]
    instrs NatBasicBlock Instr
    -> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
    forall a. a -> [a] -> [a]
    : [NatBasicBlock Instr]
    blocks, [GenCmmDecl RawCmmStatics h g]
    statics)
    mkBlocks (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
    dat GenCmmDecl 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
    instr Instr -> [Instr] -> [Instr]
    forall a. a -> [a] -> [a]
    : [Instr]
    instrs, [NatBasicBlock Instr]
    blocks, [GenCmmDecl RawCmmStatics h g]
    statics)

    -- -----------------------------------------------------------------------------

    -- | Utilities

    -- | Annotate an `Instr` with a `SDoc` comment
    ann :: SDoc -> Instr -> Instr
    ann :: SDoc -> Instr -> Instr
    ann SDoc
    doc Instr
    instr {- debugIsOn -} = SDoc -> Instr -> Instr
    ANN SDoc
    doc Instr
    instr
    {-# INLINE ann #-}

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

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

    -- Note [RISCV64 Jump Tables]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~
    --
    -- Jump tables are implemented by generating a table of relative addresses,
    -- where each entry is the relative offset to the target block from the first
    -- entry / table label (`generateJumpTableForInstr`). Using the jump table means
    -- loading the entry's value and jumping to the calculated absolute address
    -- (`genSwitch`).
    --
    -- For example, this Cmm switch
    --
    --   switch [1 .. 10] _s2wn::I64 {
    --       case 1 : goto c347;
    --       case 2 : goto c348;
    --       case 3 : goto c349;
    --       case 4 : goto c34a;
    --       case 5 : goto c34b;
    --       case 6 : goto c34c;
    --       case 7 : goto c34d;
    --       case 8 : goto c34e;
    --       case 9 : goto c34f;
    --       case 10 : goto c34g;
    --   }   // CmmSwitch
    --
    -- leads to this jump table in Assembly
    --
    --   .section .rodata
    --           .balign 8
    --   .Ln34G:
    --           .quad   0
    --           .quad   .Lc347-(.Ln34G)+0
    --           .quad   .Lc348-(.Ln34G)+0
    --           .quad   .Lc349-(.Ln34G)+0
    --           .quad   .Lc34a-(.Ln34G)+0
    --           .quad   .Lc34b-(.Ln34G)+0
    --           .quad   .Lc34c-(.Ln34G)+0
    --           .quad   .Lc34d-(.Ln34G)+0
    --           .quad   .Lc34e-(.Ln34G)+0
    --           .quad   .Lc34f-(.Ln34G)+0
    --           .quad   .Lc34g-(.Ln34G)+0
    --
    -- and this indexing code where the jump should be done (register t0 contains
    -- the index)
    --
    --           addi t0, t0, 0 // silly move (ignore it)
    --           la t1, .Ln34G // load the table's address
    --           sll t0, t0, 3 // index * 8 -> offset in bytes
    --           add t0, t0, t1 // address of the table's entry
    --           ld t0, 0(t0) // load entry
    --           add t0, t0, t1 // relative to absolute address
    --           jalr zero, t0, 0 // jump to the block
    --
    -- In object code (disassembled) the table looks like
    --
    --   0000000000000000 <.Ln34G>:
    --        ...
    --        8: R_RISCV_ADD64        .Lc347
    --        8: R_RISCV_SUB64        .Ln34G
    --        10: R_RISCV_ADD64       .Lc348
    --        10: R_RISCV_SUB64       .Ln34G
    --        18: R_RISCV_ADD64       .Lc349
    --        18: R_RISCV_SUB64       .Ln34G
    --        20: R_RISCV_ADD64       .Lc34a
    --        20: R_RISCV_SUB64       .Ln34G
    --        28: R_RISCV_ADD64       .Lc34b
    --        28: R_RISCV_SUB64       .Ln34G
    --        30: R_RISCV_ADD64       .Lc34c
    --        30: R_RISCV_SUB64       .Ln34G
    --        38: R_RISCV_ADD64       .Lc34d
    --        38: R_RISCV_SUB64       .Ln34G
    --        40: R_RISCV_ADD64       .Lc34e
    --        40: R_RISCV_SUB64       .Ln34G
    --        48: R_RISCV_ADD64       .Lc34f
    --        48: R_RISCV_SUB64       .Ln34G
    --        50: R_RISCV_ADD64       .Lc34g
    --        50: R_RISCV_SUB64       .Ln34G
    --
    -- I.e. the relative offset calculations are done by the linker via relocations.
    -- This seems to be PIC compatible; at least `scanelf` (pax-utils) does not
    -- complain.

    -- | Generate jump to jump table target
    --
    -- The index into the jump table is calulated by evaluating @expr@. The
    -- corresponding table entry contains the relative address to jump to (relative
    -- to the jump table's first entry / the table's own label).
    genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM InstrBlock
    genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM (OrdList Instr)
    genSwitch NCGConfig
    config CmmExpr
    expr SwitchTargets
    targets = do
      (reg, fmt1, e_code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    indexExpr
      let fmt = Format
    II64
      targetReg <- getNewRegNat fmt
      lbl <- getNewLabelNat
      dynRef <- cmmMakeDynamicReference config DataReference lbl
      (tableReg, fmt2, t_code) <- getSomeReg dynRef
      let code =
            [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
              [ SDoc -> Instr
    COMMENT ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "indexExpr" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text ([Char] -> SDoc) -> (CmmExpr -> [Char]) -> CmmExpr -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmExpr -> [Char]
    forall a. Show a => a -> [Char]
    show) CmmExpr
    indexExpr),
                SDoc -> Instr
    COMMENT ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "dynRef" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text ([Char] -> SDoc) -> (CmmExpr -> [Char]) -> CmmExpr -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmExpr -> [Char]
    forall a. Show a => a -> [Char]
    show) CmmExpr
    dynRef)
              ]
              OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    e_code
              OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    t_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
                [ SDoc -> Instr
    COMMENT (FastString -> SDoc
    forall doc. IsLine doc => FastString -> doc
    ftext FastString
    "Jump table for switch"),
                  -- index to offset into the table (relative to tableReg)
                  CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    SLL (Width -> Reg -> Operand
    OpReg (Format -> Width
    formatToWidth Format
    fmt1) Reg
    reg) (Width -> Reg -> Operand
    OpReg (Format -> Width
    formatToWidth Format
    fmt1) Reg
    reg) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    3))),
                  -- calculate table entry address
                  Operand -> Operand -> Operand -> Instr
    ADD (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    targetReg) (Width -> Reg -> Operand
    OpReg (Format -> Width
    formatToWidth Format
    fmt1) Reg
    reg) (Width -> Reg -> Operand
    OpReg (Format -> Width
    formatToWidth Format
    fmt2) Reg
    tableReg),
                  -- load table entry (relative offset from tableReg (first entry) to target label)
                  Format -> Operand -> Operand -> Instr
    LDRU Format
    II64 (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    targetReg) (AddrMode -> Operand
    OpAddr (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    targetReg (Int -> Imm
    ImmInt Int
    0))),
                  -- calculate absolute address of the target label
                  Operand -> Operand -> Operand -> Instr
    ADD (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    targetReg) (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    targetReg) (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    tableReg),
                  -- prepare jump to target label
                  [Maybe BlockId] -> Maybe CLabel -> Reg -> Instr
    J_TBL [Maybe BlockId]
    ids (CLabel -> Maybe CLabel
    forall a. a -> Maybe a
    Just CLabel
    lbl) Reg
    targetReg
                ]
      return code
      where
        -- See Note [Sub-word subtlety during jump-table indexing] in
        -- GHC.CmmToAsm.X86.CodeGen for why we must first offset, then widen.
        indexExpr0 :: CmmExpr
    indexExpr0 = Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffset Platform
    platform CmmExpr
    expr Int
    offset
        -- We widen to a native-width register to sanitize the high bits
        indexExpr :: CmmExpr
    indexExpr =
          MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp
            (Width -> Width -> MachOp
    MO_UU_Conv Width
    expr_w (Platform -> Width
    platformWordWidth Platform
    platform))
            [CmmExpr
    indexExpr0]
        expr_w :: Width
    expr_w = Platform -> CmmExpr -> Width
    cmmExprWidth Platform
    platform CmmExpr
    expr
        (Int
    offset, [Maybe BlockId]
    ids) = SwitchTargets -> (Int, [Maybe BlockId])
    switchTargetsToTable SwitchTargets
    targets
        platform :: Platform
    platform = NCGConfig -> Platform
    ncgPlatform NCGConfig
    config

    -- | Generate jump table data (if required)
    --
    -- The idea is to emit one table entry per case. The entry is the relative
    -- address of the block to jump to (relative to the table's first entry /
    -- table's own label.) The calculation itself is done by the linker.
    generateJumpTableForInstr ::
      NCGConfig ->
      Instr ->
      Maybe (NatCmmDecl RawCmmStatics Instr)
    generateJumpTableForInstr :: NCGConfig -> Instr -> Maybe (NatCmmDecl RawCmmStatics Instr)
    generateJumpTableForInstr NCGConfig
    config (J_TBL [Maybe BlockId]
    ids (Just CLabel
    lbl) Reg
    _) =
      let jumpTable :: [CmmStatic]
    jumpTable =
            (Maybe BlockId -> CmmStatic) -> [Maybe BlockId] -> [CmmStatic]
    forall a b. (a -> b) -> [a] -> [b]
    map Maybe BlockId -> CmmStatic
    jumpTableEntryRel [Maybe BlockId]
    ids
            where
              jumpTableEntryRel :: Maybe BlockId -> CmmStatic
    jumpTableEntryRel Maybe BlockId
    Nothing =
                CmmLit -> CmmStatic
    CmmStaticLit (Integer -> Width -> CmmLit
    CmmInt Integer
    0 (NCGConfig -> Width
    ncgWordWidth NCGConfig
    config))
              jumpTableEntryRel (Just BlockId
    blockid) =
                CmmLit -> CmmStatic
    CmmStaticLit
                  ( CLabel -> CLabel -> Int -> Width -> CmmLit
    CmmLabelDiffOff
                      CLabel
    blockLabel
                      CLabel
    lbl
                      Int
    0
                      (NCGConfig -> Width
    ncgWordWidth NCGConfig
    config)
                  )
                where
                  blockLabel :: CLabel
    blockLabel = BlockId -> CLabel
    blockLbl BlockId
    blockid
       in NatCmmDecl RawCmmStatics Instr
    -> Maybe (NatCmmDecl RawCmmStatics Instr)
    forall a. a -> Maybe a
    Just (Section -> RawCmmStatics -> NatCmmDecl RawCmmStatics Instr
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData (SectionType -> CLabel -> Section
    Section SectionType
    ReadOnlyData CLabel
    lbl) (CLabel -> [CmmStatic] -> RawCmmStatics
    forall (rawOnly :: Bool).
    CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
    CmmStaticsRaw CLabel
    lbl [CmmStatic]
    jumpTable))
    generateJumpTableForInstr NCGConfig
    _ Instr
    _ = Maybe (NatCmmDecl RawCmmStatics Instr)
    forall a. Maybe a
    Nothing

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

    stmtsToInstrs ::
      -- | Cmm Statements
      [CmmNode O O] ->
      -- | Resulting instruction
      NatM InstrBlock
    stmtsToInstrs :: [CmmNode O O] -> NatM (OrdList Instr)
    stmtsToInstrs [CmmNode O O]
    stmts = [OrdList Instr] -> OrdList Instr
    forall a. [OrdList a] -> OrdList a
    concatOL ([OrdList Instr] -> OrdList Instr)
    -> NatM [OrdList Instr] -> NatM (OrdList Instr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (CmmNode O O -> NatM (OrdList Instr))
    -> [CmmNode O O] -> NatM [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 CmmNode O O -> NatM (OrdList Instr)
    forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> NatM (OrdList Instr)
    stmtToInstrs [CmmNode O O]
    stmts

    stmtToInstrs ::
      CmmNode e x ->
      -- | Resulting instructions
      NatM InstrBlock
    stmtToInstrs :: forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> NatM (OrdList Instr)
    stmtToInstrs CmmNode e x
    stmt = do
      config <- NatM NCGConfig
    getConfig
      platform <- getPlatform
      case stmt of
        CmmUnsafeForeignCall ForeignTarget
    target [CmmFormal]
    result_regs [CmmExpr]
    args ->
          ForeignTarget -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    genCCall ForeignTarget
    target [CmmFormal]
    result_regs [CmmExpr]
    args
        CmmComment FastString
    s -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (SDoc -> Instr
    COMMENT (FastString -> SDoc
    forall doc. IsLine doc => FastString -> doc
    ftext FastString
    s)))
        CmmTick {} -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure OrdList Instr
    forall a. OrdList a
    nilOL
        CmmAssign CmmReg
    reg CmmExpr
    src
          | CmmType -> Bool
    isFloatType CmmType
    ty -> Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_FltCode Format
    format CmmReg
    reg CmmExpr
    src
          | Bool
    otherwise -> Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_IntCode Format
    format CmmReg
    reg CmmExpr
    src
          where
            ty :: CmmType
    ty = CmmReg -> CmmType
    cmmRegType CmmReg
    reg
            format :: Format
    format = CmmType -> Format
    cmmTypeFormat CmmType
    ty
        CmmStore CmmExpr
    addr CmmExpr
    src AlignmentSpec
    _alignment
          | CmmType -> Bool
    isFloatType CmmType
    ty -> Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_FltCode Format
    format CmmExpr
    addr CmmExpr
    src
          | Bool
    otherwise -> Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_IntCode Format
    format CmmExpr
    addr CmmExpr
    src
          where
            ty :: CmmType
    ty = Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    src
            format :: Format
    format = CmmType -> Format
    cmmTypeFormat CmmType
    ty
        CmmBranch BlockId
    id -> BlockId -> NatM (OrdList Instr)
    genBranch BlockId
    id
        -- We try to arrange blocks such that the likely branch is the fallthrough
        -- in GHC.Cmm.ContFlowOpt. So we can assume the condition is likely false here.
        CmmCondBranch CmmExpr
    arg BlockId
    true BlockId
    false Maybe Bool
    _prediction ->
          BlockId -> BlockId -> CmmExpr -> NatM (OrdList Instr)
    genCondBranch BlockId
    true BlockId
    false CmmExpr
    arg
        CmmSwitch CmmExpr
    arg SwitchTargets
    ids -> NCGConfig -> CmmExpr -> SwitchTargets -> NatM (OrdList Instr)
    genSwitch NCGConfig
    config 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 (f :: * -> *) a. Applicative f => a -> f a
    pure OrdList Instr
    forall a. OrdList a
    nilOL
        -- Intentionally not have a default case here: If anybody adds a
        -- constructor, the compiler should force them to think about this here.
        CmmForeignCall {} -> [Char] -> SDoc -> NatM (OrdList Instr)
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "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)
        CmmEntry {} -> [Char] -> SDoc -> NatM (OrdList Instr)
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "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
    _format Reg
    reg OrdList Instr
    code) = Format -> Reg -> OrdList Instr -> Register
    Fixed Format
    format' Reg
    reg OrdList Instr
    code
    swizzleRegisterRep Format
    format' (Any Format
    _format Reg -> OrdList Instr
    codefn) = Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format' Reg -> OrdList Instr
    codefn

    -- | Grab a `Reg` for a `CmmReg`
    --
    -- `LocalReg`s are assigned virtual registers (`RegVirtual`), `GlobalReg`s are
    -- assigned real registers (`RegReal`). It is an error if a `GlobalReg` is not a
    -- STG register.
    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 GlobalRegUse
    mid) =
      case Platform -> GlobalReg -> Maybe RealReg
    globalRegMaybe Platform
    platform (GlobalRegUse -> GlobalReg
    globalRegUse_reg GlobalRegUse
    mid) of
        Just RealReg
    reg -> RealReg -> Reg
    RegReal RealReg
    reg
        Maybe RealReg
    Nothing -> [Char] -> SDoc -> Reg
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "getRegisterReg-memory" (CmmReg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (CmmReg -> SDoc) -> CmmReg -> SDoc
    forall a b. (a -> b) -> a -> b
    $ GlobalRegUse -> CmmReg
    CmmGlobal GlobalRegUse
    mid)

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

    -- | Compute an expression into any register
    getSomeReg :: CmmExpr -> NatM (Reg, Format, InstrBlock)
    getSomeReg :: CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr = do
      r <- CmmExpr -> NatM Register
    getRegister CmmExpr
    expr
      case r of
        Any Format
    rep Reg -> OrdList Instr
    code -> do
          newReg <- Format -> NatM Reg
    getNewRegNat Format
    rep
          return (newReg, rep, code newReg)
        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)

    -- | Compute an expression into any floating-point register
    --
    -- If the initial expression is not a floating-point expression, finally move
    -- the result into a floating-point register.
    getFloatReg :: (HasCallStack) => CmmExpr -> NatM (Reg, Format, InstrBlock)
    getFloatReg :: HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getFloatReg CmmExpr
    expr = do
      r <- CmmExpr -> NatM Register
    getRegister CmmExpr
    expr
      case r of
        Any Format
    rep Reg -> OrdList Instr
    code | Format -> Bool
    isFloatFormat Format
    rep -> do
          newReg <- Format -> NatM Reg
    getNewRegNat Format
    rep
          return (newReg, rep, code newReg)
        Any Format
    II32 Reg -> OrdList Instr
    code -> do
          newReg <- Format -> NatM Reg
    getNewRegNat Format
    FF32
          return (newReg, FF32, code newReg)
        Any Format
    II64 Reg -> OrdList Instr
    code -> do
          newReg <- Format -> NatM Reg
    getNewRegNat Format
    FF64
          return (newReg, FF64, code newReg)
        Any Format
    _w Reg -> OrdList Instr
    _code -> do
          config <- NatM NCGConfig
    getConfig
          pprPanic "can't do getFloatReg on" (pdoc (ncgPlatform config) expr)
        -- can't do much for fixed.
        Fixed Format
    rep Reg
    reg OrdList Instr
    code ->
          (Reg, Format, OrdList Instr) -> NatM (Reg, Format, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    reg, Format
    rep, OrdList Instr
    code)

    -- | Map `CmmLit` to `OpImm`
    --
    -- N.B. this is a partial function, because not all `CmmLit`s have an immediate
    -- representation.
    litToImm' :: CmmLit -> Operand
    litToImm' :: CmmLit -> Operand
    litToImm' = Imm -> Operand
    OpImm (Imm -> Operand) -> (CmmLit -> Imm) -> CmmLit -> Operand
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmLit -> Imm
    litToImm

    -- | Compute a `CmmExpr` into a `Register`
    getRegister :: CmmExpr -> NatM Register
    getRegister :: CmmExpr -> NatM Register
    getRegister CmmExpr
    e = do
      config <- NatM NCGConfig
    getConfig
      getRegister' config (ncgPlatform config) e

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

    -- Note [Signed arithmetic on RISCV64]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- Handling signed arithmetic on sub-word-size values on RISCV64 is a bit
    -- tricky as Cmm's type system does not capture signedness. While 32-bit values
    -- are fairly easy to handle due to RISCV64'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.
    --
    -- The "RISC-V Sign Extension Optimizations" LLVM tech talk presentation by
    -- Craig Topper covers possible future improvements
    -- (https://llvm.org/devmtg/2022-11/slides/TechTalk21-RISC-VSignExtensionOptimizations.pdf)
    --
    --
    -- Note [Handling PIC on RV64]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- RV64 does not have a special PIC register, the general approach is to simply
    -- do PC-relative addressing or go through the GOT. There is assembly support
    -- for both.
    --
    -- rv64 assembly has a `la` (load address) pseudo-instruction, that allows
    -- loading a label's address into a register. The instruction is desugared into
    -- different addressing modes, e.g. PC-relative addressing:
    --
    -- 1: lui  rd1, %pcrel_hi(label)
    --    addi rd1, %pcrel_lo(1b)
    --
    -- See https://sourceware.org/binutils/docs/as/RISC_002dV_002dModifiers.html,
    -- PIC can be enabled/disabled through
    --
    --  .option pic
    --
    -- See https://sourceware.org/binutils/docs/as/RISC_002dV_002dDirectives.html#RISC_002dV_002dDirectives
    --
    -- 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 RV64. If
    -- we want to distinguish between symbol loading, we need to address this through
    -- the way we load it, not through a register.
    --

    getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register
    -- OPTIMIZATION WARNING: CmmExpr rewrites
    -- 1. Rewrite: Reg + (-n) => Reg - n
    --    TODO: this expression shouldn't even be generated to begin with.
    getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    plat (CmmMachOp (MO_Add Width
    w0) [CmmExpr
    x, CmmLit (CmmInt Integer
    i Width
    w1)])
      | Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0 =
          NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    plat (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_Sub Width
    w0) [CmmExpr
    x, CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt (-Integer
    i) Width
    w1)])
    getRegister' NCGConfig
    config Platform
    plat (CmmMachOp (MO_Sub Width
    w0) [CmmExpr
    x, CmmLit (CmmInt Integer
    i Width
    w1)])
      | Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0 =
          NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    plat (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_Add Width
    w0) [CmmExpr
    x, CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt (-Integer
    i) Width
    w1)])
    -- Generic case.
    getRegister' NCGConfig
    config Platform
    plat CmmExpr
    expr =
      case CmmExpr
    expr of
        CmmReg (CmmGlobal (GlobalRegUse GlobalReg
    PicBaseReg CmmType
    _)) ->
          -- See Note [Handling PIC on RV64]
          [Char] -> SDoc -> NatM Register
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "getRegister': There's no PIC base register on RISCV" (GlobalReg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr GlobalReg
    PicBaseReg)
        CmmLit CmmLit
    lit ->
          case CmmLit
    lit of
            CmmInt Integer
    0 Width
    w -> Register -> NatM Register
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> OrdList Instr -> Register
    Fixed (Width -> Format
    intFormat Width
    w) Reg
    zeroReg OrdList Instr
    forall a. OrdList a
    nilOL
            CmmInt Integer
    i Width
    w ->
              -- narrowU is important: Negative immediates may be
              -- sign-extended on load!
              let imm :: Operand
    imm = Imm -> Operand
    OpImm (Imm -> Operand) -> (Integer -> Imm) -> Integer -> Operand
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Imm
    ImmInteger (Integer -> Operand) -> Integer -> Operand
    forall a b. (a -> b) -> a -> b
    $ Width -> Integer -> Integer
    narrowU Width
    w Integer
    i
               in Register -> NatM Register
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (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
    w Reg
    dst) Operand
    imm)))
            CmmFloat Rational
    0 Width
    w -> do
              let op :: Operand
    op = CmmLit -> Operand
    litToImm' CmmLit
    lit
              Register -> NatM Register
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    floatFormat 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
    w Reg
    dst) Operand
    op)))
            CmmFloat Rational
    _f Width
    W8 -> [Char] -> SDoc -> NatM Register
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "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 -> [Char] -> SDoc -> NatM Register
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "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
              intReg <- Format -> NatM Reg
    getNewRegNat (Width -> Format
    intFormat Width
    W32)
              return
                ( Any
                    (floatFormat W32)
                    ( \Reg
    dst ->
                        [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                          [ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr
                              (Instr -> Instr) -> Instr -> Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    intReg) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger (Word32 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    word))),
                            Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    intReg)
                          ]
                    )
                )
            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
              intReg <- Format -> NatM Reg
    getNewRegNat (Width -> Format
    intFormat Width
    W64)
              return
                ( Any
                    (floatFormat W64)
                    ( \Reg
    dst ->
                        [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                          [ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr
                              (Instr -> Instr) -> Instr -> Instr
    forall a b. (a -> b) -> a -> b
    $ Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    intReg) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger (Word64 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word64
    word))),
                            Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    intReg)
                          ]
                    )
                )
            CmmFloat Rational
    _f Width
    _w -> [Char] -> SDoc -> NatM Register
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "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]
    _lits -> [Char] -> SDoc -> NatM Register
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "getRegister' (CmmLit:CmmVec): " (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)
            CmmLabel CLabel
    lbl -> do
              let op :: Operand
    op = Imm -> Operand
    OpImm (CLabel -> Imm
    ImmCLbl CLabel
    lbl)
                  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 -> 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 (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
              let op :: Operand
    op = Imm -> Operand
    OpImm (CLabel -> Int -> Imm
    ImmIndex CLabel
    lbl Int
    off)
                  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 -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList 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 -> do
              let op :: Operand
    op = CmmLit -> Operand
    litToImm' (CLabel -> CmmLit
    CmmLabel CLabel
    lbl)
                  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
              (off_r, _off_format, 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)
              return
                ( Any
                    format
                    ( \Reg
    dst ->
                        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 {} -> [Char] -> SDoc -> NatM Register
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "getRegister' (CmmLit:CmmLabelOff): " (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)
            CmmBlock BlockId
    _ -> [Char] -> SDoc -> NatM Register
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "getRegister' (CmmLit:CmmLabelOff): " (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)
            CmmLit
    CmmHighStackMark -> [Char] -> SDoc -> NatM Register
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "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
          let format :: Format
    format = CmmType -> Format
    cmmTypeFormat CmmType
    rep
              width :: Width
    width = CmmType -> Width
    typeWidth CmmType
    rep
          Amode addr addr_code <- Platform -> Width -> CmmExpr -> NatM Amode
    getAmode Platform
    plat Width
    width CmmExpr
    mem
          case width of
            Width
    w
              | Width
    w Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Width
    W64 ->
                  -- Load without sign-extension. See Note [Signed arithmetic on RISCV64]
                  Register -> NatM Register
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
                    ( 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
    LDRU Format
    format (Width -> Reg -> Operand
    OpReg Width
    width Reg
    dst) (AddrMode -> Operand
    OpAddr AddrMode
    addr)
                        )
                    )
            Width
    _ ->
              [Char] -> SDoc -> NatM Register
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic ([Char]
    "Width too big! Cannot load: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Width -> [Char]
    forall a. Show a => a -> [Char]
    show Width
    width) (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)
        CmmStackSlot Area
    _ Int
    _ ->
          [Char] -> SDoc -> NatM Register
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "getRegister' (CmmStackSlot): " (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)
        CmmReg CmmReg
    reg ->
          Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
            ( Format -> Reg -> OrdList Instr -> Register
    Fixed
                (CmmType -> Format
    cmmTypeFormat (CmmReg -> CmmType
    cmmRegType CmmReg
    reg))
                (Platform -> CmmReg -> Reg
    getRegisterReg Platform
    plat CmmReg
    reg)
                OrdList Instr
    forall a. OrdList a
    nilOL
            )
        CmmRegOff CmmReg
    reg Int
    off | 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 (CmmReg -> CmmType
    cmmRegType CmmReg
    reg)
        CmmRegOff CmmReg
    reg Int
    off -> do
          (off_r, _off_format, 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, _format, code) <- getSomeReg $ CmmReg reg
          return
            $ Any
              (intFormat 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 (CmmReg -> CmmType
    cmmRegType CmmReg
    reg)

        -- Handle MO_RelaxedRead as a normal CmmLoad, to allow
        -- non-trivial addressing modes to be used.
        CmmMachOp (MO_RelaxedRead Width
    w) [CmmExpr
    e] ->
          CmmExpr -> NatM Register
    getRegister (CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
    CmmLoad CmmExpr
    e (Width -> CmmType
    cmmBits Width
    w) AlignmentSpec
    NaturallyAligned)
        -- for MachOps, see GHC.Cmm.MachOp
        -- For CmmMachOp, see GHC.Cmm.Expr
        CmmMachOp MachOp
    op [CmmExpr
    e] -> do
          (reg, _format, code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    e
          case op of
            MO_Not Width
    w -> Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    w) ((Reg -> OrdList Instr) -> Register)
    -> (Reg -> OrdList Instr) -> Register
    forall a b. (a -> b) -> a -> b
    $ \Reg
    dst ->
              let w' :: Width
    w' = Width -> Width
    opRegWidth Width
    w
               in OrdList Instr
    code
                    OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                    -- pseudo instruction `not` is `xori rd, rs, -1`
                    SDoc -> Instr -> Instr
    ann ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "not") (Operand -> Operand -> Operand -> Instr
    XORI (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    reg) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt (-Int
    1))))
                    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 RISCV64]
            MO_S_Neg Width
    w -> OrdList Instr -> Width -> Reg -> NatM Register
    negate OrdList Instr
    code Width
    w Reg
    reg
            MO_F_Neg Width
    w ->
              Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
                (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> (Reg -> OrdList Instr) -> Register
    Any
                  (Width -> Format
    floatFormat Width
    w)
                  ( \Reg
    dst ->
                      OrdList Instr
    code
                        OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Operand -> Operand -> Instr
    NEG (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg)
                  )
            -- TODO: Can this case happen?
            MO_SF_Round Width
    from Width
    to | Width
    from Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    < Width
    W32 -> do
              -- extend to the smallest available representation
              (reg_x, code_x) <- Width -> Width -> Reg -> NatM (Reg, OrdList Instr)
    signExtendReg Width
    from Width
    W32 Reg
    reg
              pure
                $ Any
                  (floatFormat to)
                  ( \Reg
    dst ->
                      OrdList Instr
    code
                        OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_x
                        OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (FcvtVariant -> Operand -> Operand -> Instr
    FCVT FcvtVariant
    IntToFloat (Width -> Reg -> Operand
    OpReg Width
    to Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    from Reg
    reg_x)) -- (Signed ConVerT Float)
                  )
            MO_SF_Round Width
    from Width
    to ->
              Register -> NatM Register
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
                (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` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (FcvtVariant -> Operand -> Operand -> Instr
    FCVT FcvtVariant
    IntToFloat (Width -> Reg -> Operand
    OpReg Width
    to Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    from Reg
    reg)) -- (Signed ConVerT Float)
                  )
            -- TODO: Can this case happen?
            MO_FS_Truncate Width
    from Width
    to
              | Width
    to Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    < Width
    W32 ->
                  Register -> NatM Register
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
                    (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`
                            -- W32 is the smallest width to convert to. Decrease width afterwards.
                            CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (FcvtVariant -> Operand -> Operand -> Instr
    FCVT FcvtVariant
    FloatToInt (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    from Reg
    reg))
                            OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> Reg -> OrdList Instr
    signExtendAdjustPrecission Width
    W32 Width
    to Reg
    dst Reg
    dst -- (float convert (-> zero) signed)
                      )
            MO_FS_Truncate Width
    from Width
    to ->
              Register -> NatM Register
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
                (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` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (FcvtVariant -> Operand -> Operand -> Instr
    FCVT FcvtVariant
    FloatToInt (Width -> Reg -> Operand
    OpReg Width
    to Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    from Reg
    reg))
                        OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> OrdList Instr
    truncateReg Width
    from Width
    to Reg
    dst -- (float convert (-> zero) signed)
                  )
            MO_UU_Conv Width
    from Width
    to
              | Width
    from Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Width
    to ->
                  Register -> NatM Register
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
                    (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` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    e (Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    to Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    from Reg
    reg))
                      )
            MO_UU_Conv Width
    from Width
    to ->
              Register -> NatM Register
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
                (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` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    e (Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    from Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    from Reg
    reg))
                        OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> OrdList Instr
    truncateReg Width
    from Width
    to Reg
    dst
                  )
            MO_SS_Conv Width
    from Width
    to -> Width -> Width -> Reg -> OrdList Instr -> NatM Register
    forall {f :: * -> *}.
    Applicative f =>
    Width -> Width -> Reg -> OrdList Instr -> f 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` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    e (FcvtVariant -> Operand -> Operand -> Instr
    FCVT FcvtVariant
    FloatToFloat (Width -> Reg -> Operand
    OpReg Width
    to Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    from Reg
    reg)))
            MO_WF_Bitcast 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
    MOV (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg))
            MO_FW_Bitcast 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
    dst -> OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg))

            -- Conversions
            -- TODO: Duplication with MO_UU_Conv
            MO_XX_Conv Width
    from Width
    to
              | Width
    to Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    < Width
    from ->
                  Register -> NatM Register
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
                    (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` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    e (Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    from Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    from Reg
    reg))
                            OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> OrdList Instr
    truncateReg Width
    from Width
    to Reg
    dst
                      )
            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
            MO_AlignmentCheck Int
    align Width
    wordWidth -> do
              reg <- NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    plat CmmExpr
    e
              addAlignmentCheck align wordWidth reg
            MachOp
    x -> [Char] -> SDoc -> NatM Register
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic ([Char]
    "getRegister' (monadic CmmMachOp): " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ MachOp -> [Char]
    forall a. Show a => a -> [Char]
    show MachOp
    x) (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)
          where
            -- In the case of 16- or 8-bit values we need to sign-extend to 32-bits
            -- See Note [Signed arithmetic on RISCV64].
            negate :: OrdList Instr -> Width -> Reg -> NatM Register
    negate OrdList Instr
    code Width
    w Reg
    reg = do
              let w' :: Width
    w' = Width -> Width
    opRegWidth Width
    w
              (reg', code_sx) <- Width -> Width -> Reg -> NatM (Reg, OrdList Instr)
    signExtendReg Width
    w Width
    w' Reg
    reg
              return $ Any (intFormat w) $ \Reg
    dst ->
                OrdList Instr
    code
                  OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_sx
                  OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Operand -> Operand -> Instr
    NEG (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    reg')
                  OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> OrdList Instr
    truncateReg Width
    w' Width
    w Reg
    dst

            ss_conv :: Width -> Width -> Reg -> OrdList Instr -> f Register
    ss_conv Width
    from Width
    to Reg
    reg OrdList Instr
    code
              | Width
    from Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    < Width
    to = do
                  Register -> f Register
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Register -> f Register) -> Register -> f 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 -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> Reg -> OrdList Instr
    signExtend Width
    from Width
    to Reg
    reg Reg
    dst
                      OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> OrdList Instr
    truncateReg Width
    from Width
    to Reg
    dst
              | Width
    from Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    > Width
    to =
                  Register -> f Register
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Register -> f Register) -> Register -> f 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 -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                        [ SDoc -> Instr -> Instr
    ann
                            ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "MO_SS_Conv: narrow register signed" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    reg SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    from SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "->" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    to)
                            (Operand -> Operand -> Operand -> Instr
    SLL (Width -> Reg -> Operand
    OpReg Width
    to Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    from Reg
    reg) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    shift))),
                          -- signed right shift
                          Operand -> Operand -> Operand -> Instr
    SRA (Width -> Reg -> Operand
    OpReg Width
    to Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    to Reg
    dst) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    shift))
                        ]
                      OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> OrdList Instr
    truncateReg Width
    from Width
    to Reg
    dst
              | Bool
    otherwise =
                  -- No conversion necessary: Just copy.
                  Register -> f Register
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Register -> f Register) -> Register -> f Register
    forall a b. (a -> b) -> a -> b
    $ Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    from) ((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 -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    from Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    from Reg
    reg)
              where
                shift :: Int
    shift = Int
    64 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Width -> Int
    widthInBits Width
    from Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Width -> Int
    widthInBits Width
    to)

        -- Dyadic machops:
        --
        -- The general idea is:
        -- compute x<i> <- x
        -- compute x<j> <- y
        -- OP x<r>, x<i>, x<j>
        --
        -- TODO: for now we'll only implement the 64bit versions. And rely on the
        --      fallthrough to alert us if things go wrong!
        -- OPTIMIZATION WARNING: Dyadic CmmMachOp destructuring
        -- 0. TODO This should not exist! Rewrite: Reg +- 0 -> Reg
        CmmMachOp (MO_Add Width
    _) [expr' :: CmmExpr
    expr'@(CmmReg (CmmGlobal GlobalRegUse
    _r)), CmmLit (CmmInt Integer
    0 Width
    _)] -> NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    plat CmmExpr
    expr'
        CmmMachOp (MO_Sub Width
    _) [expr' :: CmmExpr
    expr'@(CmmReg (CmmGlobal GlobalRegUse
    _r)), CmmLit (CmmInt Integer
    0 Width
    _)] -> NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    plat CmmExpr
    expr'
        -- 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 -> Bool
    forall a. (Num a, Ord a) => a -> Bool
    fitsIn12bitImm 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
    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))))
          where
            -- TODO: 12bits lsl #12; e.g. lower 12 bits of n are 0; shift n >> 12, and set lsl to #12.
            w' :: Width
    w' = Format -> Width
    formatToWidth (CmmType -> Format
    cmmTypeFormat (CmmReg -> CmmType
    cmmRegType CmmReg
    reg))
            r' :: Reg
    r' = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    plat CmmReg
    reg
        CmmMachOp (MO_Sub Width
    w) [CmmReg CmmReg
    reg, CmmLit (CmmInt Integer
    n Width
    _)]
          | Integer -> Bool
    forall a. (Num a, Ord a) => a -> Bool
    fitsIn12bitImm 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
    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))))
          where
            -- TODO: 12bits lsl #12; e.g. lower 12 bits of n are 0; shift n >> 12, and set lsl to #12.
            w' :: Width
    w' = Format -> Width
    formatToWidth (CmmType -> Format
    cmmTypeFormat (CmmReg -> CmmType
    cmmRegType CmmReg
    reg))
            r' :: Reg
    r' = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    plat CmmReg
    reg
        CmmMachOp (MO_U_Quot Width
    w) [CmmExpr
    x, CmmExpr
    y] | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8 Bool -> Bool -> Bool
    || Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W16 -> do
          (reg_x, format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (reg_y, format_y, code_y) <- getSomeReg y
          return
            $ Any
              (intFormat w)
              ( \Reg
    dst ->
                  OrdList Instr
    code_x
                    OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> OrdList Instr
    truncateReg (Format -> Width
    formatToWidth Format
    format_x) Width
    w Reg
    reg_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` Width -> Width -> Reg -> OrdList Instr
    truncateReg (Format -> Width
    formatToWidth Format
    format_y) Width
    w Reg
    reg_y
                    OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    DIVU (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_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
              return
                $ Any
                  (intFormat w)
                  ( \Reg
    dst ->
                      OrdList Instr
    code_x
                        OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    SLL (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)))
                        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
                  )
        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_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
              return
                $ Any
                  (intFormat w)
                  ( \Reg
    dst ->
                      OrdList Instr
    code_x
                        OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    SLL (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)))
                        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
                  )
        CmmMachOp (MO_S_Shr Width
    w) [CmmExpr
    x, CmmLit (CmmInt Integer
    n Width
    _)] | Integer -> Bool
    forall a. (Num a, Ord a) => a -> Bool
    fitsIn12bitImm Integer
    n -> do
          (reg_x, format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (reg_x', code_x') <- signExtendReg (formatToWidth format_x) w reg_x
          return
            $ Any
              (intFormat w)
              ( \Reg
    dst ->
                  OrdList Instr
    code_x
                    OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_x'
                    OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    SRA (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, CmmExpr
    y] -> do
          (reg_x, format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (reg_y, _format_y, code_y) <- getSomeReg y
          (reg_x', code_x') <- signExtendReg (formatToWidth format_x) w reg_x
          return
            $ Any
              (intFormat w)
              ( \Reg
    dst ->
                  OrdList Instr
    code_x
                    OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_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 -> Operand -> Instr
    SRA (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
    W8,
            Integer
    0 Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    n,
            Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    8 -> do
              (reg_x, format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
              return
                $ Any
                  (intFormat w)
                  ( \Reg
    dst ->
                      OrdList Instr
    code_x
                        OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> OrdList Instr
    truncateReg (Format -> Width
    formatToWidth Format
    format_x) Width
    w Reg
    reg_x
                        OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    SRL (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
    W16,
            Integer
    0 Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    n,
            Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    16 -> do
              (reg_x, format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
              return
                $ Any
                  (intFormat w)
                  ( \Reg
    dst ->
                      OrdList Instr
    code_x
                        OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> OrdList Instr
    truncateReg (Format -> Width
    formatToWidth Format
    format_x) Width
    w Reg
    reg_x
                        OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    SRL (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, CmmExpr
    y] | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8 Bool -> Bool -> Bool
    || Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W16 -> do
          (reg_x, format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return
            $ Any
              (intFormat w)
              ( \Reg
    dst ->
                  OrdList Instr
    code_x
                    OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y
                    OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> OrdList Instr
    truncateReg (Format -> Width
    formatToWidth Format
    format_x) Width
    w Reg
    reg_x
                    OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    SRL (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_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
              return
                $ Any
                  (intFormat w)
                  ( \Reg
    dst ->
                      OrdList Instr
    code_x
                        OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    SRL (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_x, _format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
              return
                $ Any
                  (intFormat w)
                  ( \Reg
    dst ->
                      OrdList Instr
    code_x
                        OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    SRL (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
    forall a. (Num a, Ord a) => a -> Bool
    fitsIn12bitImm Integer
    n ->
              Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    w) (\Reg
    d -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    AND (Width -> Reg -> Operand
    OpReg Width
    w Reg
    d) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    n))))
          where
            w' :: Width
    w' = Format -> Width
    formatToWidth (CmmType -> Format
    cmmTypeFormat (CmmReg -> CmmType
    cmmRegType CmmReg
    reg))
            r' :: Reg
    r' = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    plat CmmReg
    reg
        CmmMachOp (MO_Or Width
    w) [CmmReg CmmReg
    reg, CmmLit (CmmInt Integer
    n Width
    _)]
          | Integer -> Bool
    forall a. (Num a, Ord a) => a -> Bool
    fitsIn12bitImm 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
    ORI (Width -> Reg -> Operand
    OpReg Width
    w Reg
    d) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    n))))
          where
            w' :: Width
    w' = Format -> Width
    formatToWidth (CmmType -> Format
    cmmTypeFormat (CmmReg -> CmmType
    cmmRegType CmmReg
    reg))
            r' :: Reg
    r' = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    plat CmmReg
    reg

        -- Generic binary case.
        CmmMachOp MachOp
    op [CmmExpr
    x, CmmExpr
    y] -> do
          let -- 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_x, format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
                (reg_y, format_y, code_y) <- getSomeReg y
                massertPpr (isIntFormat format_x == isIntFormat format_y) $ text "bitOp: incompatible"
                return
                  $ Any
                    (intFormat w)
                    ( \Reg
    dst ->
                        OrdList Instr
    code_x
                          OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y
                          OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Operand -> Operand -> Operand -> OrdList Instr
    op (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (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 RISCV64].
              intOp :: Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    intOp Bool
    is_signed Width
    w Operand -> Operand -> Operand -> OrdList Instr
    op = do
                -- compute x<m> <- x
                -- compute x<o> <- y
                -- <OP> x<n>, x<m>, x<o>
                (reg_x, format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
                (reg_y, format_y, code_y) <- getSomeReg y
                massertPpr (isIntFormat format_x && isIntFormat format_y) $ text "intOp: non-int"
                -- This is the width of the registers on which the operation
                -- should be performed.
                let w' = Width -> Width
    opRegWidth Width
    w
                    signExt Reg
    r
                      | Bool -> Bool
    not Bool
    is_signed = (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    r, OrdList Instr
    forall a. OrdList a
    nilOL)
                      | Bool
    otherwise = Width -> Width -> Reg -> NatM (Reg, OrdList Instr)
    signExtendReg Width
    w Width
    w' Reg
    r
                (reg_x_sx, code_x_sx) <- signExt reg_x
                (reg_y_sx, code_y_sx) <- signExt reg_y
                return $ Any (intFormat w) $ \Reg
    dst ->
                  OrdList Instr
    code_x
                    OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y
                    OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    -- sign-extend both operands
                    OrdList Instr
    code_x_sx
                    OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y_sx
                    OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Operand -> Operand -> Operand -> OrdList Instr
    op (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    reg_x_sx) (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    reg_y_sx)
                    OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> OrdList Instr
    truncateReg Width
    w' Width
    w Reg
    dst -- truncate back to the operand's original width
              floatOp :: Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    floatOp Width
    w Operand -> Operand -> Operand -> OrdList Instr
    op = do
                (reg_fx, format_x, code_fx) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
    CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getFloatReg CmmExpr
    x
                (reg_fy, format_y, code_fy) <- getFloatReg y
                massertPpr (isFloatFormat format_x && isFloatFormat format_y) $ text "floatOp: non-float"
                return
                  $ Any
                    (floatFormat w)
                    ( \Reg
    dst ->
                        OrdList Instr
    code_fx
                          OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_fy
                          OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Operand -> Operand -> Operand -> OrdList Instr
    op (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_fx) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_fy)
                    )

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

          case MachOp
    op of
            -- Integer operations
            -- Add/Sub should only be Integer Options.
            MO_Add Width
    w -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> 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))
            -- 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
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Cond -> Instr
    CSET Operand
    d Operand
    x Operand
    y 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
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Cond -> Instr
    CSET Operand
    d Operand
    x Operand
    y 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
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    MUL Operand
    d Operand
    x Operand
    y))
            MO_S_MulMayOflo Width
    w -> Width -> CmmExpr -> CmmExpr -> NatM Register
    do_mul_may_oflo Width
    w CmmExpr
    x CmmExpr
    y
            MO_S_Quot Width
    w -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    intOp Bool
    True Width
    w (\Operand
    d Operand
    x Operand
    y -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    DIV Operand
    d Operand
    x Operand
    y))
            MO_S_Rem 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
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    REM Operand
    d Operand
    x Operand
    y))
            -- Unsigned multiply/divide
            MO_U_Quot Width
    w -> Bool
    -> Width
    -> (Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    intOp Bool
    False Width
    w (\Operand
    d Operand
    x Operand
    y -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    DIVU Operand
    d Operand
    x Operand
    y))
            MO_U_Rem 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
    REMU Operand
    d Operand
    x Operand
    y))
            -- Signed comparisons
            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
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Cond -> Instr
    CSET Operand
    d Operand
    x Operand
    y 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
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Cond -> Instr
    CSET Operand
    d Operand
    x Operand
    y 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
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Cond -> Instr
    CSET Operand
    d Operand
    x Operand
    y 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
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Cond -> Instr
    CSET Operand
    d Operand
    x Operand
    y 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
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Cond -> Instr
    CSET Operand
    d Operand
    x Operand
    y 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
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Cond -> Instr
    CSET Operand
    d Operand
    x Operand
    y 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
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Cond -> Instr
    CSET Operand
    d Operand
    x Operand
    y 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
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Cond -> Instr
    CSET Operand
    d Operand
    x Operand
    y 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
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (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
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (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
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (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
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    DIV Operand
    d Operand
    x Operand
    y))
            -- Floating point comparison
            MO_F_Min 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
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    FMIN Operand
    d Operand
    x Operand
    y))
            MO_F_Max 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
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    FMAX Operand
    d Operand
    x Operand
    y))
            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
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Cond -> Instr
    CSET Operand
    d Operand
    x Operand
    y 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
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Cond -> Instr
    CSET Operand
    d Operand
    x Operand
    y Cond
    NE))
            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
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Cond -> Instr
    CSET Operand
    d Operand
    x Operand
    y Cond
    FGE))
            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
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Cond -> Instr
    CSET Operand
    d Operand
    x Operand
    y Cond
    FLE)) -- 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
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Cond -> Instr
    CSET Operand
    d Operand
    x Operand
    y Cond
    FGT))
            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
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Cond -> Instr
    CSET Operand
    d Operand
    x Operand
    y Cond
    FLT)) -- 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
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (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
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    OR 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
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    XOR 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
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    SLL 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
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    SRL 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
    $ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    SRA Operand
    d Operand
    x Operand
    y))
            MachOp
    op -> [Char] -> SDoc -> NatM Register
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "getRegister' (unhandled dyadic CmmMachOp): " (SDoc -> NatM Register) -> SDoc -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ MachOp -> SDoc
    pprMachOp MachOp
    op SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "in" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr

        -- Generic ternary case.
        CmmMachOp MachOp
    op [CmmExpr
    x, CmmExpr
    y, CmmExpr
    z] ->
          case MachOp
    op of
            -- Floating-point fused multiply-add operations
            --
            -- x86 fmadd    x * y + z <=> RISCV64 fmadd : d =   r1 * r2 + r3
            -- x86 fmsub    x * y - z <=> RISCV64 fnmsub: d =   r1 * r2 - r3
            -- x86 fnmadd - x * y + z <=> RISCV64 fmsub : d = - r1 * r2 + r3
            -- x86 fnmsub - x * y - z <=> RISCV64 fnmadd: d = - r1 * r2 - r3
            MO_FMA FMASign
    var Int
    l Width
    w
              | Int
    l Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1
              -> case FMASign
    var of
                    FMASign
    FMAdd -> Width
    -> (Operand -> Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    float3Op Width
    w (\Operand
    d Operand
    n Operand
    m Operand
    a -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ FMASign -> Operand -> Operand -> Operand -> Operand -> Instr
    FMA FMASign
    FMAdd Operand
    d Operand
    n Operand
    m Operand
    a)
                    FMASign
    FMSub -> Width
    -> (Operand -> Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    float3Op Width
    w (\Operand
    d Operand
    n Operand
    m Operand
    a -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ FMASign -> Operand -> Operand -> Operand -> Operand -> Instr
    FMA FMASign
    FMSub Operand
    d Operand
    n Operand
    m Operand
    a)
                    FMASign
    FNMAdd -> Width
    -> (Operand -> Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    float3Op Width
    w (\Operand
    d Operand
    n Operand
    m Operand
    a -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ FMASign -> Operand -> Operand -> Operand -> Operand -> Instr
    FMA FMASign
    FNMSub Operand
    d Operand
    n Operand
    m Operand
    a)
                    FMASign
    FNMSub -> Width
    -> (Operand -> Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    float3Op Width
    w (\Operand
    d Operand
    n Operand
    m Operand
    a -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ FMASign -> Operand -> Operand -> Operand -> Operand -> Instr
    FMA FMASign
    FNMAdd Operand
    d Operand
    n Operand
    m Operand
    a)
              | Bool
    otherwise
              -> [Char] -> NatM Register
    forall a. HasCallStack => [Char] -> a
    sorry [Char]
    "The RISCV64 backend does not (yet) support vectors."
            MachOp
    _ ->
              [Char] -> SDoc -> NatM Register
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "getRegister' (unhandled ternary CmmMachOp): "
                (SDoc -> NatM Register) -> SDoc -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ MachOp -> SDoc
    pprMachOp MachOp
    op
                SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "in"
                SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr
          where
            float3Op :: Width
    -> (Operand -> Operand -> Operand -> Operand -> OrdList Instr)
    -> NatM Register
    float3Op Width
    w Operand -> Operand -> Operand -> Operand -> OrdList Instr
    op = do
              (reg_fx, format_x, code_fx) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
    CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getFloatReg CmmExpr
    x
              (reg_fy, format_y, code_fy) <- getFloatReg y
              (reg_fz, format_z, code_fz) <- getFloatReg z
              massertPpr (isFloatFormat format_x && isFloatFormat format_y && isFloatFormat format_z)
                $ text "float3Op: non-float"
              pure
                $ Any (floatFormat w)
                $ \Reg
    dst ->
                  OrdList Instr
    code_fx
                    OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_fy
                    OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_fz
                    OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Operand -> Operand -> Operand -> Operand -> OrdList Instr
    op (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_fx) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_fy) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_fz)
        CmmMachOp MachOp
    _op [CmmExpr]
    _xs ->
          [Char] -> SDoc -> NatM Register
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "getRegister' (variadic CmmMachOp): " (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    plat CmmExpr
    expr)
      where
        isNbitEncodeable :: Int -> Integer -> Bool
        isNbitEncodeable :: Int -> Integer -> Bool
    isNbitEncodeable Int
    n 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)
        -- N.B. MUL does not set the overflow flag.
        -- Return 0 when the operation cannot overflow, /= 0 otherwise
        do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
        do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
    do_mul_may_oflo Width
    w CmmExpr
    _x CmmExpr
    _y | Width
    w Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    > Width
    W64 = [Char] -> SDoc -> NatM Register
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "Cannot multiply larger than 64bit" (Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w)
        do_mul_may_oflo w :: Width
    w@Width
    W64 CmmExpr
    x CmmExpr
    y = do
          (reg_x, format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (reg_y, format_y, code_y) <- getSomeReg y
          -- TODO: Can't we clobber reg_x and reg_y to save registers?
          lo <- getNewRegNat II64
          hi <- getNewRegNat II64
          -- TODO: Overhaul CSET: 3rd operand isn't needed for SNEZ
          let nonSense = Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    0)
          pure
            $ Any
              (intFormat w)
              ( \Reg
    dst ->
                  OrdList Instr
    code_x
                    OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> Reg -> OrdList Instr
    signExtend (Format -> Width
    formatToWidth Format
    format_x) Width
    W64 Reg
    reg_x Reg
    reg_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` Width -> Width -> Reg -> Reg -> OrdList Instr
    signExtend (Format -> Width
    formatToWidth Format
    format_y) Width
    W64 Reg
    reg_y Reg
    reg_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
                      [ CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    MULH (Width -> Reg -> Operand
    OpReg Width
    w Reg
    hi) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y)),
                        Operand -> Operand -> Operand -> Instr
    MUL (Width -> Reg -> Operand
    OpReg Width
    w Reg
    lo) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y),
                        Operand -> Operand -> Operand -> Instr
    SRA (Width -> Reg -> Operand
    OpReg Width
    w Reg
    lo) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    lo) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt (Width -> Int
    widthInBits Width
    W64 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))),
                        SDoc -> Instr -> Instr
    ann
                          ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "Set flag if result of MULH contains more than sign bits.")
                          (Operand -> Operand -> Operand -> Instr
    XOR (Width -> Reg -> Operand
    OpReg Width
    w Reg
    hi) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    hi) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    lo)),
                        Operand -> Operand -> Operand -> Cond -> Instr
    CSET (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    hi) Operand
    nonSense Cond
    NE
                      ]
              )
        do_mul_may_oflo Width
    w CmmExpr
    x CmmExpr
    y = do
          (reg_x, format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
          (reg_y, format_y, code_y) <- getSomeReg y
          let width_x = Format -> Width
    formatToWidth Format
    format_x
              width_y = Format -> Width
    formatToWidth Format
    format_y
          if w > width_x && w > width_y
            then
              pure
                $ Any
                  (intFormat w)
                  ( \Reg
    dst ->
                      -- 8bit * 8bit cannot overflow 16bit
                      -- 16bit * 16bit cannot overflow 32bit
                      -- 32bit * 32bit cannot overflow 64bit
                      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
    dst) Operand
    zero (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    0)))
                  )
            else do
              let use32BitMul = Width
    w Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Width
    W32 Bool -> Bool -> Bool
    && Width
    width_x Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Width
    W32 Bool -> Bool -> Bool
    && Width
    width_y Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Width
    W32
                  nonSense = Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    0)
              if use32BitMul
                then do
                  narrowedReg <- getNewRegNat II64
                  pure
                    $ Any
                      (intFormat w)
                      ( \Reg
    dst ->
                          OrdList Instr
    code_x
                            OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> Reg -> OrdList Instr
    signExtend (Format -> Width
    formatToWidth Format
    format_x) Width
    W32 Reg
    reg_x Reg
    reg_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` Width -> Width -> Reg -> Reg -> OrdList Instr
    signExtend (Format -> Width
    formatToWidth Format
    format_y) Width
    W32 Reg
    reg_y Reg
    reg_y
                            OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Operand -> Operand -> Operand -> Instr
    MUL (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    reg_x) (Width -> Reg -> Operand
    OpReg Width
    W32 Reg
    reg_y))
                            OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> Reg -> OrdList Instr
    signExtendAdjustPrecission Width
    W32 Width
    w Reg
    dst Reg
    narrowedReg
                            OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                              [ SDoc -> Instr -> Instr
    ann
                                  ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "Check if the multiplied value fits in the narrowed register")
                                  (Operand -> Operand -> Operand -> Instr
    SUB (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    narrowedReg)),
                                Operand -> Operand -> Operand -> Cond -> Instr
    CSET (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) Operand
    nonSense Cond
    NE
                              ]
                      )
                else
                  pure
                    $ Any
                      (intFormat w)
                      ( \Reg
    dst ->
                          -- Do not handle this unlikely case. Just tell that it may overflow.
                          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
    dst) Operand
    zero (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    1)))
                      )

    -- | Instructions to sign-extend the value in the given register from width @w@
    -- up to width @w'@.
    signExtendReg :: Width -> Width -> Reg -> NatM (Reg, OrdList Instr)
    signExtendReg :: Width -> Width -> Reg -> NatM (Reg, OrdList Instr)
    signExtendReg Width
    w Width
    _w' Reg
    r | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 = (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Reg
    r, OrdList Instr
    forall a. OrdList a
    nilOL)
    signExtendReg Width
    w Width
    w' Reg
    r = do
      r' <- Format -> NatM Reg
    getNewRegNat (Width -> Format
    intFormat Width
    w')
      let instrs = Width -> Width -> Reg -> Reg -> OrdList Instr
    signExtend Width
    w Width
    w' Reg
    r Reg
    r'
      pure (r', instrs)

    -- | Sign extends to 64bit, if needed
    --
    -- Source `Reg` @r@ stays untouched, while the conversion happens on destination
    -- `Reg` @r'@.
    signExtend :: Width -> Width -> Reg -> Reg -> OrdList Instr
    signExtend :: Width -> Width -> Reg -> Reg -> OrdList Instr
    signExtend Width
    w Width
    w' Reg
    _r Reg
    _r' | Width
    w Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    > Width
    w' = [Char] -> SDoc -> OrdList Instr
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "This is not a sign extension, but a truncation." (SDoc -> OrdList Instr) -> SDoc -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "->" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w'
    signExtend Width
    w Width
    w' Reg
    _r Reg
    _r' | Width
    w Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    > Width
    W64 Bool -> Bool -> Bool
    || Width
    w' Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    > Width
    W64 = [Char] -> SDoc -> OrdList Instr
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "Unexpected width (max is 64bit):" (SDoc -> OrdList Instr) -> SDoc -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "->" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w'
    signExtend Width
    w Width
    w' Reg
    r Reg
    r' | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 Bool -> Bool -> Bool
    && Width
    w' Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 Bool -> Bool -> Bool
    && Reg
    r Reg -> Reg -> Bool
    forall a. Eq a => a -> a -> Bool
    == Reg
    r' = OrdList Instr
    forall a. OrdList a
    nilOL
    signExtend Width
    w Width
    w' Reg
    r Reg
    r' | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 Bool -> Bool -> Bool
    && Width
    w' Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 = 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
    MOV (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r)
    signExtend Width
    w Width
    w' Reg
    r Reg
    r'
      | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W32 Bool -> Bool -> Bool
    && Width
    w' Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 =
          Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL
            (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ SDoc -> Instr -> Instr
    ann
              ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "sign-extend register (SEXT.W)" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "->" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w')
              -- `ADDIW r r 0` is the pseudo-op SEXT.W
              (Operand -> Operand -> Operand -> Instr
    ADD (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    0)))
    signExtend Width
    w Width
    w' Reg
    r Reg
    r' =
      [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
        [ SDoc -> Instr -> Instr
    ann
            ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "narrow register signed" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    ':' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "->" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    ':' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w')
            (Operand -> Operand -> Operand -> Instr
    SLL (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    shift))),
          -- signed (arithmetic) right shift
          Operand -> Operand -> Operand -> Instr
    SRA (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    shift))
        ]
      where
        shift :: Int
    shift = Int
    64 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Width -> Int
    widthInBits Width
    w

    -- | Sign extends to 64bit, if needed and reduces the precission to the target `Width` (@w'@)
    --
    -- Source `Reg` @r@ stays untouched, while the conversion happens on destination
    -- `Reg` @r'@.
    signExtendAdjustPrecission :: Width -> Width -> Reg -> Reg -> OrdList Instr
    signExtendAdjustPrecission :: Width -> Width -> Reg -> Reg -> OrdList Instr
    signExtendAdjustPrecission Width
    w Width
    w' Reg
    _r Reg
    _r' | Width
    w Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    > Width
    W64 Bool -> Bool -> Bool
    || Width
    w' Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    > Width
    W64 = [Char] -> SDoc -> OrdList Instr
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "Unexpected width (max is 64bit):" (SDoc -> OrdList Instr) -> SDoc -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "->" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w'
    signExtendAdjustPrecission Width
    w Width
    w' Reg
    r Reg
    r' | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 Bool -> Bool -> Bool
    && Width
    w' Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 Bool -> Bool -> Bool
    && Reg
    r Reg -> Reg -> Bool
    forall a. Eq a => a -> a -> Bool
    == Reg
    r' = OrdList Instr
    forall a. OrdList a
    nilOL
    signExtendAdjustPrecission Width
    w Width
    w' Reg
    r Reg
    r' | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 Bool -> Bool -> Bool
    && Width
    w' Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 = 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
    MOV (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r)
    signExtendAdjustPrecission Width
    w Width
    w' Reg
    r Reg
    r'
      | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W32 Bool -> Bool -> Bool
    && Width
    w' Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 =
          Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL
            (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ SDoc -> Instr -> Instr
    ann
              ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "sign-extend register (SEXT.W)" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "->" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w')
              -- `ADDIW r r 0` is the pseudo-op SEXT.W
              (Operand -> Operand -> Operand -> Instr
    ADD (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    0)))
    signExtendAdjustPrecission Width
    w Width
    w' Reg
    r Reg
    r'
      | Width
    w Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    > Width
    w' =
          [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
            [ SDoc -> Instr -> Instr
    ann
                ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "narrow register signed" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    ':' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "->" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    ':' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w')
                (Operand -> Operand -> Operand -> Instr
    SLL (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    shift))),
              -- signed (arithmetic) right shift
              Operand -> Operand -> Operand -> Instr
    SRA (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    shift))
            ]
      where
        shift :: Int
    shift = Int
    64 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Width -> Int
    widthInBits Width
    w'
    signExtendAdjustPrecission Width
    w Width
    w' Reg
    r Reg
    r' =
      [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
        [ SDoc -> Instr -> Instr
    ann
            ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "sign extend register" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    ':' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "->" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    ':' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w')
            (Operand -> Operand -> Operand -> Instr
    SLL (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    shift))),
          -- signed (arithmetic) right shift
          Operand -> Operand -> Operand -> Instr
    SRA (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r') (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    shift))
        ]
      where
        shift :: Int
    shift = Int
    64 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Width -> Int
    widthInBits Width
    w

    -- | Instructions to truncate the value in the given register from width @w@
    -- to width @w'@.
    --
    -- In other words, it just cuts the width out of the register. N.B.: This
    -- ignores signedness (no sign extension takes place)!
    truncateReg :: Width -> Width -> Reg -> OrdList Instr
    truncateReg :: Width -> Width -> Reg -> OrdList Instr
    truncateReg Width
    _w Width
    w' Reg
    _r | Width
    w' Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 = OrdList Instr
    forall a. OrdList a
    nilOL
    truncateReg Width
    _w Width
    w' Reg
    r | Width
    w' Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    > Width
    W64 = [Char] -> SDoc -> OrdList Instr
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "Cannot truncate to width bigger than register size (max is 64bit):" (SDoc -> OrdList Instr) -> SDoc -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text (Reg -> [Char]
    forall a. Show a => a -> [Char]
    show Reg
    r) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    ':' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w'
    truncateReg Width
    w Width
    _w' Reg
    r | Width
    w Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    > Width
    W64 = [Char] -> SDoc -> OrdList Instr
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "Unexpected register size (max is 64bit):" (SDoc -> OrdList Instr) -> SDoc -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text (Reg -> [Char]
    forall a. Show a => a -> [Char]
    show Reg
    r) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    ':' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w
    truncateReg Width
    w Width
    w' Reg
    r =
      [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
        [ SDoc -> Instr -> Instr
    ann
            ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "truncate register" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "->" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w')
            (Operand -> Operand -> Operand -> Instr
    SLL (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    shift))),
          -- SHL ignores signedness!
          Operand -> Operand -> Operand -> Instr
    SRL (Width -> Reg -> Operand
    OpReg Width
    w' Reg
    r) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    shift))
        ]
      where
        shift :: Int
    shift = Int
    64 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Width -> Int
    widthInBits Width
    w'

    -- | Given a 'Register', produce a new 'Register' with an instruction block
    -- which will check the value for alignment. Used for @-falignment-sanitisation@.
    addAlignmentCheck :: Int -> Width -> Register -> NatM Register
    addAlignmentCheck :: Int -> Width -> Register -> NatM Register
    addAlignmentCheck Int
    align Width
    wordWidth Register
    reg = do
      jumpReg <- Format -> NatM Reg
    getNewRegNat Format
    II64
      cmpReg <- getNewRegNat II64
      okayLblId <- getBlockIdNat

      pure $ case reg of
        Fixed Format
    fmt Reg
    reg OrdList Instr
    code -> Format -> Reg -> OrdList Instr -> Register
    Fixed Format
    fmt Reg
    reg (OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Format -> Reg -> Reg -> BlockId -> Reg -> OrdList Instr
    check Format
    fmt Reg
    jumpReg Reg
    cmpReg BlockId
    okayLblId Reg
    reg)
        Any Format
    fmt Reg -> OrdList Instr
    f -> Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    fmt (\Reg
    reg -> Reg -> OrdList Instr
    f Reg
    reg OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Format -> Reg -> Reg -> BlockId -> Reg -> OrdList Instr
    check Format
    fmt Reg
    jumpReg Reg
    cmpReg BlockId
    okayLblId Reg
    reg)
      where
        check :: Format -> Reg -> Reg -> BlockId -> Reg -> InstrBlock
        check :: Format -> Reg -> Reg -> BlockId -> Reg -> OrdList Instr
    check Format
    fmt Reg
    jumpReg Reg
    cmpReg BlockId
    okayLblId Reg
    reg =
          let width :: Width
    width = Format -> Width
    formatToWidth Format
    fmt
           in Bool -> OrdList Instr -> OrdList Instr
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Format -> Bool
    isFloatFormat Format
    fmt)
                (OrdList Instr -> OrdList Instr) -> OrdList Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                  [ SDoc -> Instr -> Instr
    ann
                      ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "Alignment check - alignment: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Int -> SDoc
    forall doc. IsLine doc => Int -> doc
    int Int
    align SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    ", word width: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text (Width -> [Char]
    forall a. Show a => a -> [Char]
    show Width
    wordWidth))
                      (Operand -> Operand -> Operand -> Instr
    AND (Width -> Reg -> Operand
    OpReg Width
    width Reg
    cmpReg) (Width -> Reg -> Operand
    OpReg Width
    width Reg
    reg) (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
    $ Int
    align Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)),
                    Cond -> Operand -> Operand -> Target -> Instr
    BCOND Cond
    EQ (Width -> Reg -> Operand
    OpReg Width
    width Reg
    cmpReg) Operand
    zero (BlockId -> Target
    TBlock BlockId
    okayLblId),
                    SDoc -> Instr
    COMMENT ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "Alignment check failed"),
                    Format -> Operand -> Operand -> Instr
    LDR Format
    II64 (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    jumpReg) (Imm -> Operand
    OpImm (Imm -> Operand) -> Imm -> Operand
    forall a b. (a -> b) -> a -> b
    $ CLabel -> Imm
    ImmCLbl CLabel
    mkBadAlignmentLabel),
                    Target -> Instr
    B (Reg -> Target
    TReg Reg
    jumpReg),
                    BlockId -> Instr
    NEWBLOCK BlockId
    okayLblId
                  ]

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

    -- | Provide the value of a `CmmExpr` with an `Amode`
    --
    -- N.B. this function should be used to provide operands to load and store
    -- instructions with signed 12bit wide immediates (S & I types). For other
    -- immediate sizes and formats (e.g. B type uses multiples of 2) this function
    -- would need to be adjusted.
    getAmode ::
      Platform ->
      -- | width of loaded value
      Width ->
      CmmExpr ->
      NatM Amode
    -- TODO: Specialize stuff we can destructure here.

    -- LDR/STR: Immediate can be represented with 12bits
    getAmode :: Platform -> Width -> CmmExpr -> NatM Amode
    getAmode Platform
    platform Width
    w (CmmRegOff CmmReg
    reg Int
    off)
      | Width
    w Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Width
    W64,
        Int -> Bool
    forall a. (Num a, Ord a) => a -> Bool
    fitsIn12bitImm Int
    off =
          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 -> Bool
    forall a. (Num a, Ord a) => a -> Bool
    fitsIn12bitImm Integer
    off =
          do
            (reg, _format, code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr
            return $ Amode (AddrRegImm reg (ImmInteger off)) code
    getAmode Platform
    _platform Width
    _ (CmmMachOp (MO_Sub Width
    _w) [CmmExpr
    expr, CmmLit (CmmInt Integer
    off Width
    _w')])
      | Integer -> Bool
    forall a. (Num a, Ord a) => a -> Bool
    fitsIn12bitImm (-Integer
    off) =
          do
            (reg, _format, code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr
            return $ Amode (AddrRegImm reg (ImmInteger (-off))) code

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

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

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

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

    assignReg_IntCode :: Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_IntCode Format
    _ CmmReg
    reg CmmExpr
    src =
      do
        platform <- NatM Platform
    getPlatform
        let dst = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform CmmReg
    reg
        r <- getRegister src
        return $ case r of
          Any Format
    _ Reg -> OrdList Instr
    code ->
            SDoc -> Instr
    COMMENT ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "CmmAssign" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text (CmmReg -> [Char]
    forall a. Show a => a -> [Char]
    show CmmReg
    reg)) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text (CmmExpr -> [Char]
    forall a. Show a => a -> [Char]
    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 ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "CmmAssign" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text (CmmReg -> [Char]
    forall a. Show a => a -> [Char]
    show CmmReg
    reg)) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text (CmmExpr -> [Char]
    forall a. Show a => a -> [Char]
    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
    -- AArch64 has 26bits for targets, whereas RiscV only has 20.
    -- Thus we need to distinguish between far (outside of the)
    -- current compilation unit. And regular branches.
    -- RiscV has ±2MB of displacement, whereas AArch64 has ±128MB.
    -- Thus for most branches we can get away with encoding it
    -- directly in the instruction rather than always loading the
    -- address into a register and then using that to jump.
    -- Under the assumption that our linked build product is less than
    -- ~2*128MB of TEXT, and there are no jump that span the whole
    -- TEXT segment.
    -- Something where riscv's compressed instruction might come in
    -- handy.
    genJump :: CmmExpr {-the branch target-} -> NatM InstrBlock
    genJump :: CmmExpr -> NatM (OrdList Instr)
    genJump CmmExpr
    expr = do
      (target, _format, code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr
      return (code `appOL` unitOL (annExpr expr (J (TReg target))))

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

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

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

        -- Generic case.
        CmmMachOp MachOp
    mop [CmmExpr
    x, CmmExpr
    y] -> do
          let ubcond :: Width -> Cond -> NatM (OrdList Instr)
    ubcond Width
    w Cond
    cmp = do
                -- compute both sides.
                (reg_x, format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
                (reg_y, format_y, code_y) <- getSomeReg y
                let x' = Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x
                    y' = Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y
                return $ case w of
                  Width
    w
                    | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8 Bool -> Bool -> Bool
    || Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W16 ->
                        OrdList Instr
    code_x
                          OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> OrdList Instr
    truncateReg (Format -> Width
    formatToWidth Format
    format_x) Width
    w Reg
    reg_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` Width -> Width -> Reg -> OrdList Instr
    truncateReg (Format -> Width
    formatToWidth Format
    format_y) Width
    w Reg
    reg_y
                          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 (Cond -> Operand -> Operand -> Target -> Instr
    BCOND Cond
    cmp Operand
    x' Operand
    y' (BlockId -> Target
    TBlock BlockId
    bid))
                  Width
    _ ->
                    OrdList Instr
    code_x
                      OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y
                      OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Cond -> Operand -> Operand -> Target -> Instr
    BCOND Cond
    cmp Operand
    x' Operand
    y' (BlockId -> Target
    TBlock BlockId
    bid))

              sbcond :: Width -> Cond -> NatM (OrdList Instr)
    sbcond Width
    w Cond
    cmp = do
                -- compute both sides.
                (reg_x, format_x, code_x) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    x
                (reg_y, format_y, code_y) <- getSomeReg y
                let x' = Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_x
                    y' = Width -> Reg -> Operand
    OpReg Width
    w Reg
    reg_y
                return $ case w of
                  Width
    w
                    | Width
    w Width -> [Width] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Width
    W8, Width
    W16, Width
    W32] ->
                        OrdList Instr
    code_x
                          OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> Reg -> OrdList Instr
    signExtend (Format -> Width
    formatToWidth Format
    format_x) Width
    W64 Reg
    reg_x Reg
    reg_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` Width -> Width -> Reg -> Reg -> OrdList Instr
    signExtend (Format -> Width
    formatToWidth Format
    format_y) Width
    W64 Reg
    reg_y Reg
    reg_y
                          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 (Cond -> Operand -> Operand -> Target -> Instr
    BCOND Cond
    cmp Operand
    x' Operand
    y' (BlockId -> Target
    TBlock BlockId
    bid)))
                  Width
    _ -> OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (CmmExpr -> Instr -> Instr
    annExpr CmmExpr
    expr (Cond -> Operand -> Operand -> Target -> Instr
    BCOND Cond
    cmp Operand
    x' Operand
    y' (BlockId -> Target
    TBlock BlockId
    bid)))

              fbcond :: Width -> Cond -> NatM (OrdList Instr)
    fbcond Width
    w Cond
    cmp = do
                -- ensure we get float regs
                (reg_fx, _format_fx, code_fx) <- HasCallStack => CmmExpr -> NatM (Reg, Format, OrdList Instr)
    CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getFloatReg CmmExpr
    x
                (reg_fy, _format_fy, code_fy) <- getFloatReg y
                condOpReg <- OpReg W64 <$> getNewRegNat II64
                oneReg <- getNewRegNat II64
                return $ code_fx
                  `appOL` code_fy
                  `snocOL` annExpr expr (CSET condOpReg (OpReg w reg_fx) (OpReg w reg_fy) cmp)
                  `snocOL` MOV (OpReg W64 oneReg) (OpImm (ImmInt 1))
                  `snocOL` BCOND EQ condOpReg (OpReg w oneReg) (TBlock bid)

          case MachOp
    mop of
            MO_F_Eq Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    fbcond Width
    w Cond
    EQ
            MO_F_Ne Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    fbcond Width
    w Cond
    NE
            MO_F_Gt Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    fbcond Width
    w Cond
    FGT
            MO_F_Ge Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    fbcond Width
    w Cond
    FGE
            MO_F_Lt Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    fbcond Width
    w Cond
    FLT
            MO_F_Le Width
    w -> Width -> Cond -> NatM (OrdList Instr)
    fbcond Width
    w Cond
    FLE
            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
    _ -> [Char] -> SDoc -> NatM (OrdList Instr)
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "RV64.genCondJump:case mop: " ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text ([Char] -> SDoc) -> [Char] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> [Char]
    forall a. Show a => a -> [Char]
    show CmmExpr
    expr)
        CmmExpr
    _ -> [Char] -> SDoc -> NatM (OrdList Instr)
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "RV64.genCondJump: " ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text ([Char] -> SDoc) -> [Char] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> [Char]
    forall a. Show a => a -> [Char]
    show CmmExpr
    expr)

    -- | Generate conditional branching instructions
    --
    -- This is basically an "if with else" statement.
    genCondBranch ::
      -- | the true branch target
      BlockId ->
      -- | the false branch target
      BlockId ->
      -- | the condition on which to branch
      CmmExpr ->
      -- | Instructions
      NatM InstrBlock
    genCondBranch :: BlockId -> BlockId -> CmmExpr -> NatM (OrdList Instr)
    genCondBranch BlockId
    true BlockId
    false CmmExpr
    expr =
      OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    appOL
        (OrdList Instr -> OrdList Instr -> OrdList Instr)
    -> NatM (OrdList Instr) -> NatM (OrdList Instr -> OrdList Instr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BlockId -> CmmExpr -> NatM (OrdList Instr)
    genCondJump BlockId
    true CmmExpr
    expr
        NatM (OrdList Instr -> OrdList Instr)
    -> NatM (OrdList Instr) -> NatM (OrdList Instr)
    forall a b. NatM (a -> b) -> NatM a -> NatM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> BlockId -> NatM (OrdList Instr)
    genBranch BlockId
    false

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

    -- | Generate a call to a C function.
    --
    -- - Integer values are passed in GP registers a0-a7.
    -- - Floating point values are passed in FP registers fa0-fa7.
    -- - If there are no free floating point registers, the FP values are passed in GP registers.
    -- - If all GP registers are taken, the values are spilled as whole words (!) onto the stack.
    -- - For integers/words, the return value is in a0.
    -- - The return value is in fa0 if the return type is a floating point value.
    genCCall ::
      ForeignTarget -> -- function to call
      [CmmFormal] -> -- where to put the result
      [CmmActual] -> -- arguments (of mixed type)
      NatM InstrBlock
    -- TODO: Specialize where we can.
    -- Generic impl
    genCCall :: ForeignTarget -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    genCCall target :: ForeignTarget
    target@(ForeignTarget CmmExpr
    expr ForeignConvention
    _cconv) [CmmFormal]
    dest_regs [CmmExpr]
    arg_regs = do
      -- we want to pass arg_regs into allArgRegs
      -- The target :: ForeignTarget call can either
      -- be a foreign procedure with an address expr
      -- and a calling convention.
      (call_target_reg, call_target_code) <-
        -- Compute the address of the call target into a register. This
        -- addressing enables us to jump through the whole address space
        -- without further ado. PC-relative addressing would involve
        -- instructions to do similar, though.
        do
          (reg, _format, reg_code) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    expr
          pure (reg, reg_code)
      -- compute the code and register logic for all arg_regs.
      -- this will give us the format information to match on.
      arg_regs' <- mapM getSomeReg arg_regs

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

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

      readResultsCode <- readResults allGpArgRegs allFpArgRegs dest_regs [] nilOL

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

      let code =
            OrdList Instr
    call_target_code -- compute the label (possibly into a register)
              OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Int -> OrdList Instr
    moveStackDown Int
    stackSpaceWords
              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 -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> [Reg] -> Instr
    BL Reg
    call_target_reg [Reg]
    passRegs -- branch and link (C calls aren't tail calls, but return)
              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
    stackSpaceWords
      return code
      where
        -- Implementiation of the RISCV ABI calling convention.
        -- https://github.com/riscv-non-isa/riscv-elf-psabi-doc/blob/948463cd5dbebea7c1869e20146b17a2cc8fda2f/riscv-cc.adoc#integer-calling-convention
        passArguments :: [Reg] -> [Reg] -> [(Reg, Format, ForeignHint, InstrBlock)] -> Int -> [Reg] -> InstrBlock -> NatM (Int, [Reg], InstrBlock)
        -- Base case: no more arguments to pass (left)
        passArguments :: [Reg]
    -> [Reg]
    -> [(Reg, Format, ForeignHint, OrdList Instr)]
    -> Int
    -> [Reg]
    -> OrdList Instr
    -> NatM (Int, [Reg], OrdList Instr)
    passArguments [Reg]
    _ [Reg]
    _ [] Int
    stackSpaceWords [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
    stackSpaceWords, [Reg]
    accumRegs, OrdList Instr
    accumCode)
        -- Still have GP regs, and we want to pass an GP argument.
        passArguments (Reg
    gpReg : [Reg]
    gpRegs) [Reg]
    fpRegs ((Reg
    r, Format
    format, ForeignHint
    hint, OrdList Instr
    code_r) : [(Reg, Format, ForeignHint, OrdList Instr)]
    args) Int
    stackSpaceWords [Reg]
    accumRegs OrdList Instr
    accumCode | Format -> Bool
    isIntFormat Format
    format = do
          -- RISCV64 Integer Calling Convention: "When passed in registers or on the
          -- stack, integer scalars narrower than XLEN bits are widened according to
          -- the sign of their type up to 32 bits, then sign-extended to XLEN bits."
          let w :: Width
    w = Format -> Width
    formatToWidth Format
    format
              assignArg :: OrdList Instr
    assignArg =
                if ForeignHint
    hint ForeignHint -> ForeignHint -> Bool
    forall a. Eq a => a -> a -> Bool
    == ForeignHint
    SignedHint
                  then
                    SDoc -> Instr
    COMMENT ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "Pass gp argument sign-extended (SignedHint): " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r)
                      Instr -> OrdList Instr -> OrdList Instr
    forall a. a -> OrdList a -> OrdList a
    `consOL` Width -> Width -> Reg -> Reg -> OrdList Instr
    signExtend Width
    w Width
    W64 Reg
    r Reg
    gpReg
                  else
                    [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                      [ SDoc -> Instr
    COMMENT ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "Pass gp argument sign-extended (SignedHint): " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r),
                        Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    w Reg
    gpReg) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r)
                      ]
              accumCode' :: OrdList Instr
    accumCode' =
                OrdList Instr
    accumCode
                  OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_r
                  OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    assignArg
          [Reg]
    -> [Reg]
    -> [(Reg, Format, ForeignHint, OrdList Instr)]
    -> Int
    -> [Reg]
    -> OrdList Instr
    -> NatM (Int, [Reg], OrdList Instr)
    passArguments [Reg]
    gpRegs [Reg]
    fpRegs [(Reg, Format, ForeignHint, OrdList Instr)]
    args Int
    stackSpaceWords (Reg
    gpReg Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : [Reg]
    accumRegs) OrdList Instr
    accumCode'

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

        -- No mor regs left to pass. Must pass on stack.
        passArguments [] [] ((Reg
    r, Format
    format, ForeignHint
    hint, OrdList Instr
    code_r) : [(Reg, Format, ForeignHint, OrdList Instr)]
    args) Int
    stackSpaceWords [Reg]
    accumRegs OrdList Instr
    accumCode = do
          let w :: Width
    w = Format -> Width
    formatToWidth Format
    format
              spOffet :: Int
    spOffet = Int
    8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    stackSpaceWords
              str :: Instr
    str = Format -> Operand -> Operand -> Instr
    STR Format
    format (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r) (AddrMode -> Operand
    OpAddr (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    spMachReg (Int -> Imm
    ImmInt Int
    spOffet)))
              stackCode :: OrdList Instr
    stackCode =
                if ForeignHint
    hint ForeignHint -> ForeignHint -> Bool
    forall a. Eq a => a -> a -> Bool
    == ForeignHint
    SignedHint
                  then
                    OrdList Instr
    code_r
                      OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Width -> Width -> Reg -> Reg -> OrdList Instr
    signExtend Width
    w Width
    W64 Reg
    r Reg
    tmpReg
                      OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` SDoc -> Instr -> Instr
    ann ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "Pass signed argument (size " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    ") on the stack: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    tmpReg) Instr
    str
                  else
                    OrdList Instr
    code_r
                      OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` SDoc -> Instr -> Instr
    ann ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "Pass unsigned argument (size " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    ") on the stack: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r) Instr
    str
          [Reg]
    -> [Reg]
    -> [(Reg, Format, ForeignHint, OrdList Instr)]
    -> Int
    -> [Reg]
    -> OrdList Instr
    -> NatM (Int, [Reg], OrdList Instr)
    passArguments [] [] [(Reg, Format, ForeignHint, OrdList Instr)]
    args (Int
    stackSpaceWords Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) [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 [] [Reg]
    fpRegs ((Reg
    r, Format
    format, ForeignHint
    _hint, OrdList Instr
    code_r) : [(Reg, Format, ForeignHint, OrdList Instr)]
    args) Int
    stackSpaceWords [Reg]
    accumRegs OrdList Instr
    accumCode | Format -> Bool
    isIntFormat Format
    format = do
          let w :: Width
    w = Format -> Width
    formatToWidth Format
    format
              spOffet :: Int
    spOffet = Int
    8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    stackSpaceWords
              str :: Instr
    str = Format -> Operand -> Operand -> Instr
    STR Format
    format (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r) (AddrMode -> Operand
    OpAddr (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    spMachReg (Int -> Imm
    ImmInt Int
    spOffet)))
              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 ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "Pass argument (size " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    w SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    ") on the stack: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r) Instr
    str
          [Reg]
    -> [Reg]
    -> [(Reg, Format, ForeignHint, OrdList Instr)]
    -> Int
    -> [Reg]
    -> OrdList Instr
    -> NatM (Int, [Reg], OrdList Instr)
    passArguments [] [Reg]
    fpRegs [(Reg, Format, ForeignHint, OrdList Instr)]
    args (Int
    stackSpaceWords Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) [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 in gpReg then.
        passArguments (Reg
    gpReg : [Reg]
    gpRegs) [] ((Reg
    r, Format
    format, ForeignHint
    _hint, OrdList Instr
    code_r) : [(Reg, Format, ForeignHint, OrdList Instr)]
    args) Int
    stackSpaceWords [Reg]
    accumRegs OrdList Instr
    accumCode | Format -> Bool
    isFloatFormat Format
    format = do
          let w :: Width
    w = Format -> Width
    formatToWidth Format
    format
              mov :: Instr
    mov = Operand -> Operand -> Instr
    MOV (Width -> Reg -> Operand
    OpReg Width
    w Reg
    gpReg) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    r)
              accumCode' :: OrdList Instr
    accumCode' =
                OrdList Instr
    accumCode
                  OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_r
                  OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` SDoc -> Instr -> Instr
    ann ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "Pass fp argument in gpReg: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r) Instr
    mov
          [Reg]
    -> [Reg]
    -> [(Reg, Format, ForeignHint, OrdList Instr)]
    -> Int
    -> [Reg]
    -> OrdList Instr
    -> NatM (Int, [Reg], OrdList Instr)
    passArguments [Reg]
    gpRegs [] [(Reg, Format, ForeignHint, OrdList Instr)]
    args Int
    stackSpaceWords (Reg
    gpReg Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : [Reg]
    accumRegs) OrdList Instr
    accumCode'
        passArguments [Reg]
    _ [Reg]
    _ [(Reg, Format, ForeignHint, OrdList Instr)]
    _ Int
    _ [Reg]
    _ OrdList Instr
    _ = [Char] -> SDoc -> NatM (Int, [Reg], OrdList Instr)
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "passArguments" ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "invalid state")

        readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg] -> InstrBlock -> NatM InstrBlock
        readResults :: [Reg]
    -> [Reg]
    -> [CmmFormal]
    -> [Reg]
    -> OrdList Instr
    -> NatM (OrdList Instr)
    readResults [Reg]
    _ [Reg]
    _ [] [Reg]
    _ OrdList Instr
    accumCode = OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    accumCode
        readResults [] [Reg]
    _ [CmmFormal]
    _ [Reg]
    _ OrdList Instr
    _ = do
          platform <- NatM Platform
    getPlatform
          pprPanic "genCCall, out of gp registers when reading results" (pdoc platform target)
        readResults [Reg]
    _ [] [CmmFormal]
    _ [Reg]
    _ OrdList Instr
    _ = do
          platform <- NatM Platform
    getPlatform
          pprPanic "genCCall, out of fp registers when reading results" (pdoc platform target)
        readResults (Reg
    gpReg : [Reg]
    gpRegs) (Reg
    fpReg : [Reg]
    fpRegs) (CmmFormal
    dst : [CmmFormal]
    dsts) [Reg]
    accumRegs OrdList Instr
    accumCode = do
          -- gp/fp reg -> dst
          platform <- NatM Platform
    getPlatform
          let rep = CmmReg -> CmmType
    cmmRegType (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
              format = CmmType -> Format
    cmmTypeFormat CmmType
    rep
              w = CmmReg -> Width
    cmmRegWidth (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
              r_dst = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
          if isFloatFormat format
            then readResults (gpReg : gpRegs) fpRegs dsts (fpReg : accumRegs) (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w fpReg))
            else
              readResults gpRegs (fpReg : fpRegs) dsts (gpReg : accumRegs)
                $ accumCode
                `snocOL` MOV (OpReg w r_dst) (OpReg w gpReg)
                `appOL`
                -- truncate, otherwise an unexpectedly big value might be used in upfollowing calculations
                truncateReg W64 w r_dst
    genCCall (PrimTarget CallishMachOp
    mop) [CmmFormal]
    dest_regs [CmmExpr]
    arg_regs = do
      case CallishMachOp
    mop of
        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)
    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
        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)
    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
        -- 64 bit float ops
        CallishMachOp
    MO_F64_Pwr -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "pow"
        CallishMachOp
    MO_F64_Sin -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "sin"
        CallishMachOp
    MO_F64_Cos -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "cos"
        CallishMachOp
    MO_F64_Tan -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "tan"
        CallishMachOp
    MO_F64_Sinh -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "sinh"
        CallishMachOp
    MO_F64_Cosh -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "cosh"
        CallishMachOp
    MO_F64_Tanh -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "tanh"
        CallishMachOp
    MO_F64_Asin -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "asin"
        CallishMachOp
    MO_F64_Acos -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "acos"
        CallishMachOp
    MO_F64_Atan -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "atan"
        CallishMachOp
    MO_F64_Asinh -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "asinh"
        CallishMachOp
    MO_F64_Acosh -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "acosh"
        CallishMachOp
    MO_F64_Atanh -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "atanh"
        CallishMachOp
    MO_F64_Log -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "log"
        CallishMachOp
    MO_F64_Log1P -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "log1p"
        CallishMachOp
    MO_F64_Exp -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "exp"
        CallishMachOp
    MO_F64_ExpM1 -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "expm1"
        CallishMachOp
    MO_F64_Fabs -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "fabs"
        CallishMachOp
    MO_F64_Sqrt -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "sqrt"
        -- 32 bit float ops
        CallishMachOp
    MO_F32_Pwr -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "powf"
        CallishMachOp
    MO_F32_Sin -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "sinf"
        CallishMachOp
    MO_F32_Cos -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "cosf"
        CallishMachOp
    MO_F32_Tan -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "tanf"
        CallishMachOp
    MO_F32_Sinh -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "sinhf"
        CallishMachOp
    MO_F32_Cosh -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "coshf"
        CallishMachOp
    MO_F32_Tanh -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "tanhf"
        CallishMachOp
    MO_F32_Asin -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "asinf"
        CallishMachOp
    MO_F32_Acos -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "acosf"
        CallishMachOp
    MO_F32_Atan -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "atanf"
        CallishMachOp
    MO_F32_Asinh -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "asinhf"
        CallishMachOp
    MO_F32_Acosh -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "acoshf"
        CallishMachOp
    MO_F32_Atanh -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "atanhf"
        CallishMachOp
    MO_F32_Log -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "logf"
        CallishMachOp
    MO_F32_Log1P -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "log1pf"
        CallishMachOp
    MO_F32_Exp -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "expf"
        CallishMachOp
    MO_F32_ExpM1 -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "expm1f"
        CallishMachOp
    MO_F32_Fabs -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "fabsf"
        CallishMachOp
    MO_F32_Sqrt -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "sqrtf"
        -- 64-bit primops
        CallishMachOp
    MO_I64_ToI -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_int64ToInt"
        CallishMachOp
    MO_I64_FromI -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_intToInt64"
        CallishMachOp
    MO_W64_ToW -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_word64ToWord"
        CallishMachOp
    MO_W64_FromW -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_wordToWord64"
        CallishMachOp
    MO_x64_Neg -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_neg64"
        CallishMachOp
    MO_x64_Add -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_add64"
        CallishMachOp
    MO_x64_Sub -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_sub64"
        CallishMachOp
    MO_x64_Mul -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_mul64"
        CallishMachOp
    MO_I64_Quot -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_quotInt64"
        CallishMachOp
    MO_I64_Rem -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_remInt64"
        CallishMachOp
    MO_W64_Quot -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_quotWord64"
        CallishMachOp
    MO_W64_Rem -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_remWord64"
        CallishMachOp
    MO_x64_And -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_and64"
        CallishMachOp
    MO_x64_Or -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_or64"
        CallishMachOp
    MO_x64_Xor -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_xor64"
        CallishMachOp
    MO_x64_Not -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_not64"
        CallishMachOp
    MO_x64_Shl -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_uncheckedShiftL64"
        CallishMachOp
    MO_I64_Shr -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_uncheckedIShiftRA64"
        CallishMachOp
    MO_W64_Shr -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_uncheckedShiftRL64"
        CallishMachOp
    MO_x64_Eq -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_eq64"
        CallishMachOp
    MO_x64_Ne -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_ne64"
        CallishMachOp
    MO_I64_Ge -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_geInt64"
        CallishMachOp
    MO_I64_Gt -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_gtInt64"
        CallishMachOp
    MO_I64_Le -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_leInt64"
        CallishMachOp
    MO_I64_Lt -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_ltInt64"
        CallishMachOp
    MO_W64_Ge -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_geWord64"
        CallishMachOp
    MO_W64_Gt -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_gtWord64"
        CallishMachOp
    MO_W64_Le -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_leWord64"
        CallishMachOp
    MO_W64_Lt -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "hs_ltWord64"
        -- Conversion
        MO_UF_Conv Width
    w -> FastString -> NatM (OrdList Instr)
    mkCCall (Width -> FastString
    word2FloatLabel Width
    w)
        -- Optional MachOps
        -- These are enabled/disabled by backend flags: GHC.StgToCmm.Config
        MO_S_Mul2 Width
    _w -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        MO_S_QuotRem Width
    _w -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        MO_U_QuotRem Width
    _w -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        MO_U_QuotRem2 Width
    _w -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        MO_Add2 Width
    _w -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        MO_AddWordC Width
    _w -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        MO_SubWordC Width
    _w -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        MO_AddIntC Width
    _w -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        MO_SubIntC Width
    _w -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        MO_U_Mul2 Width
    _w -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        MO_VS_Quot {} -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        MO_VS_Rem {} -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        MO_VU_Quot {} -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        MO_VU_Rem {} -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        CallishMachOp
    MO_I64X2_Min -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        CallishMachOp
    MO_I64X2_Max -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        CallishMachOp
    MO_W64X2_Min -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        CallishMachOp
    MO_W64X2_Max -> CallishMachOp -> NatM (OrdList Instr)
    forall a b. Show a => a -> b
    unsupported CallishMachOp
    mop
        -- Memory Ordering
        -- The related C functions are:
        -- #include <stdatomic.h>
        -- atomic_thread_fence(memory_order_acquire);
        -- atomic_thread_fence(memory_order_release);
        -- atomic_thread_fence(memory_order_seq_cst);
        CallishMachOp
    MO_AcquireFence -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (FenceType -> FenceType -> Instr
    FENCE FenceType
    FenceRead FenceType
    FenceReadWrite))
        CallishMachOp
    MO_ReleaseFence -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (FenceType -> FenceType -> Instr
    FENCE FenceType
    FenceReadWrite FenceType
    FenceWrite))
        CallishMachOp
    MO_SeqCstFence -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (FenceType -> FenceType -> Instr
    FENCE FenceType
    FenceReadWrite FenceType
    FenceReadWrite))
        CallishMachOp
    MO_Touch -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure OrdList Instr
    forall a. OrdList a
    nilOL -- Keep variables live (when using interior pointers)
        -- Prefetch
        MO_Prefetch_Data Int
    _n -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure OrdList Instr
    forall a. OrdList a
    nilOL -- Prefetch hint.

        -- Memory copy/set/move/cmp, with alignment for optimization
        MO_Memcpy Int
    _align -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "memcpy"
        MO_Memset Int
    _align -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "memset"
        MO_Memmove Int
    _align -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "memmove"
        MO_Memcmp Int
    _align -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "memcmp"
        CallishMachOp
    MO_SuspendThread -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "suspendThread"
        CallishMachOp
    MO_ResumeThread -> FastString -> NatM (OrdList Instr)
    mkCCall FastString
    "resumeThread"
        MO_PopCnt Width
    w -> FastString -> NatM (OrdList Instr)
    mkCCall (Width -> FastString
    popCntLabel Width
    w)
        MO_Pdep Width
    w -> FastString -> NatM (OrdList Instr)
    mkCCall (Width -> FastString
    pdepLabel Width
    w)
        MO_Pext Width
    w -> FastString -> NatM (OrdList Instr)
    mkCCall (Width -> FastString
    pextLabel Width
    w)
        MO_Clz Width
    w -> FastString -> NatM (OrdList Instr)
    mkCCall (Width -> FastString
    clzLabel Width
    w)
        MO_Ctz Width
    w -> FastString -> NatM (OrdList Instr)
    mkCCall (Width -> FastString
    ctzLabel Width
    w)
        MO_BSwap Width
    w -> FastString -> NatM (OrdList Instr)
    mkCCall (Width -> FastString
    bSwapLabel Width
    w)
        MO_BRev Width
    w -> FastString -> NatM (OrdList Instr)
    mkCCall (Width -> FastString
    bRevLabel Width
    w)
        -- Atomic read-modify-write.
        mo :: CallishMachOp
    mo@(MO_AtomicRead Width
    w MemoryOrdering
    ord)
          | [CmmExpr
    p_reg] <- [CmmExpr]
    arg_regs,
            [CmmFormal
    dst_reg] <- [CmmFormal]
    dest_regs -> do
              (p, _fmt_p, code_p) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    p_reg
              platform <- getPlatform
              -- Analog to the related MachOps (above)
              -- The related C functions are:
              -- #include <stdatomic.h>
              -- __atomic_load_n(&a, __ATOMIC_ACQUIRE);
              -- __atomic_load_n(&a, __ATOMIC_SEQ_CST);
              let instrs = case MemoryOrdering
    ord of
                    MemoryOrdering
    MemOrderRelaxed -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ SDoc -> Instr -> Instr
    ann SDoc
    moDescr (Format -> Operand -> Operand -> Instr
    LDR (Width -> Format
    intFormat Width
    w) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (AddrMode -> Operand
    OpAddr (AddrMode -> Operand) -> AddrMode -> Operand
    forall a b. (a -> b) -> a -> b
    $ Reg -> AddrMode
    AddrReg Reg
    p))
                    MemoryOrdering
    MemOrderAcquire ->
                      [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                        [ SDoc -> Instr -> Instr
    ann SDoc
    moDescr (Format -> Operand -> Operand -> Instr
    LDR (Width -> Format
    intFormat Width
    w) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (AddrMode -> Operand
    OpAddr (AddrMode -> Operand) -> AddrMode -> Operand
    forall a b. (a -> b) -> a -> b
    $ Reg -> AddrMode
    AddrReg Reg
    p)),
                          FenceType -> FenceType -> Instr
    FENCE FenceType
    FenceRead FenceType
    FenceReadWrite
                        ]
                    MemoryOrdering
    MemOrderSeqCst ->
                      [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                        [ SDoc -> Instr -> Instr
    ann SDoc
    moDescr (FenceType -> FenceType -> Instr
    FENCE FenceType
    FenceReadWrite FenceType
    FenceReadWrite),
                          Format -> Operand -> Operand -> Instr
    LDR (Width -> Format
    intFormat Width
    w) (Width -> Reg -> Operand
    OpReg Width
    w Reg
    dst) (AddrMode -> Operand
    OpAddr (AddrMode -> Operand) -> AddrMode -> Operand
    forall a b. (a -> b) -> a -> b
    $ Reg -> AddrMode
    AddrReg Reg
    p),
                          FenceType -> FenceType -> Instr
    FENCE FenceType
    FenceRead FenceType
    FenceReadWrite
                        ]
                    MemoryOrdering
    MemOrderRelease -> [Char] -> OrdList Instr
    forall a. HasCallStack => [Char] -> a
    panic ([Char] -> OrdList Instr) -> [Char] -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Unexpected MemOrderRelease on an AtomicRead: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ CallishMachOp -> [Char]
    forall a. Show a => a -> [Char]
    show CallishMachOp
    mo
                  dst = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst_reg)
                  moDescr = ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text ([Char] -> SDoc)
    -> (CallishMachOp -> [Char]) -> CallishMachOp -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CallishMachOp -> [Char]
    forall a. Show a => a -> [Char]
    show) CallishMachOp
    mo
                  code = OrdList Instr
    code_p OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    instrs
              return code
          | Bool
    otherwise -> [Char] -> NatM (OrdList Instr)
    forall a. HasCallStack => [Char] -> a
    panic [Char]
    "mal-formed AtomicRead"
        mo :: CallishMachOp
    mo@(MO_AtomicWrite Width
    w MemoryOrdering
    ord)
          | [CmmExpr
    p_reg, CmmExpr
    val_reg] <- [CmmExpr]
    arg_regs -> do
              (p, _fmt_p, code_p) <- CmmExpr -> NatM (Reg, Format, OrdList Instr)
    getSomeReg CmmExpr
    p_reg
              (val, fmt_val, code_val) <- getSomeReg val_reg
              -- Analog to the related MachOps (above)
              -- The related C functions are:
              -- #include <stdatomic.h>
              -- __atomic_store_n(&a, 23, __ATOMIC_SEQ_CST);
              -- __atomic_store_n(&a, 23, __ATOMIC_RELEASE);
              let instrs = case MemoryOrdering
    ord of
                    MemoryOrdering
    MemOrderRelaxed -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ SDoc -> Instr -> Instr
    ann SDoc
    moDescr (Format -> Operand -> Operand -> Instr
    STR Format
    fmt_val (Width -> Reg -> Operand
    OpReg Width
    w Reg
    val) (AddrMode -> Operand
    OpAddr (AddrMode -> Operand) -> AddrMode -> Operand
    forall a b. (a -> b) -> a -> b
    $ Reg -> AddrMode
    AddrReg Reg
    p))
                    MemoryOrdering
    MemOrderSeqCst ->
                      [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                        [ SDoc -> Instr -> Instr
    ann SDoc
    moDescr (FenceType -> FenceType -> Instr
    FENCE FenceType
    FenceReadWrite FenceType
    FenceWrite),
                          Format -> Operand -> Operand -> Instr
    STR Format
    fmt_val (Width -> Reg -> Operand
    OpReg Width
    w Reg
    val) (AddrMode -> Operand
    OpAddr (AddrMode -> Operand) -> AddrMode -> Operand
    forall a b. (a -> b) -> a -> b
    $ Reg -> AddrMode
    AddrReg Reg
    p),
                          FenceType -> FenceType -> Instr
    FENCE FenceType
    FenceReadWrite FenceType
    FenceReadWrite
                        ]
                    MemoryOrdering
    MemOrderRelease ->
                      [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                        [ SDoc -> Instr -> Instr
    ann SDoc
    moDescr (FenceType -> FenceType -> Instr
    FENCE FenceType
    FenceReadWrite FenceType
    FenceWrite),
                          Format -> Operand -> Operand -> Instr
    STR Format
    fmt_val (Width -> Reg -> Operand
    OpReg Width
    w Reg
    val) (AddrMode -> Operand
    OpAddr (AddrMode -> Operand) -> AddrMode -> Operand
    forall a b. (a -> b) -> a -> b
    $ Reg -> AddrMode
    AddrReg Reg
    p)
                        ]
                    MemoryOrdering
    MemOrderAcquire -> [Char] -> OrdList Instr
    forall a. HasCallStack => [Char] -> a
    panic ([Char] -> OrdList Instr) -> [Char] -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Unexpected MemOrderAcquire on an AtomicWrite" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ CallishMachOp -> [Char]
    forall a. Show a => a -> [Char]
    show CallishMachOp
    mo
                  moDescr = ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text ([Char] -> SDoc)
    -> (CallishMachOp -> [Char]) -> CallishMachOp -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CallishMachOp -> [Char]
    forall a. Show a => a -> [Char]
    show) CallishMachOp
    mo
                  code =
                    OrdList Instr
    code_p
                      OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_val
                      OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    instrs
              pure code
          | Bool
    otherwise -> [Char] -> NatM (OrdList Instr)
    forall a. HasCallStack => [Char] -> a
    panic [Char]
    "mal-formed AtomicWrite"
        MO_AtomicRMW Width
    w AtomicMachOp
    amop -> FastString -> NatM (OrdList Instr)
    mkCCall (Width -> AtomicMachOp -> FastString
    atomicRMWLabel Width
    w AtomicMachOp
    amop)
        MO_Cmpxchg Width
    w -> FastString -> NatM (OrdList Instr)
    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)
    mkCCall (Width -> FastString
    xchgLabel Width
    w)
      where
        unsupported :: (Show a) => a -> b
        unsupported :: forall a b. Show a => a -> b
    unsupported a
    mop =
          [Char] -> b
    forall a. HasCallStack => [Char] -> a
    panic
            ( [Char]
    "outOfLineCmmOp: "
                [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    mop
                [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " not supported here"
            )
        mkCCall :: FastString -> NatM InstrBlock
        mkCCall :: FastString -> NatM (OrdList Instr)
    mkCCall FastString
    name = do
          config <- NatM NCGConfig
    getConfig
          target <-
            cmmMakeDynamicReference config CallReference
              $ mkForeignLabel name ForeignLabelInThisPackage IsFunction
          let cconv = CCallConv
    -> [ForeignHint]
    -> [ForeignHint]
    -> CmmReturnInfo
    -> ForeignConvention
    ForeignConvention CCallConv
    CCallConv [ForeignHint
    NoHint] [ForeignHint
    NoHint] CmmReturnInfo
    CmmMayReturn
          genCCall (ForeignTarget target cconv) dest_regs arg_regs

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

    {- Note [RISCV64 far jumps]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~

    RISCV64 conditional jump instructions can only encode an offset of +/-4KiB
    (12bits) which is usually enough but can be exceeded in edge cases. In these
    cases we will replace:

      b.cond <cond> foo

    with the sequence:

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

    and

      b foo

    with the sequence:

      la reg foo
      b reg

    Compared to AArch64 the target label is loaded to a register, because
    unconditional jump instructions can only address +/-1MiB. The LA
    pseudo-instruction will be replaced by up to two real instructions, ensuring
    correct addressing.

    One could surely find more efficient replacements, taking PC-relative addressing
    into account. This could be a future improvement. (As far branches are pretty
    rare, one might question and measure the value of such improvement.)

    RISCV has many pseudo-instructions which emit more than one real instructions.
    Thus, we count the real instructions after the Assembler has seen them.

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

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

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

    -}

    -- | A conditional jump to a far target
    --
    -- By loading the far target into a register for the jump, we can address the
    -- whole memory range.
    genCondFarJump :: (MonadGetUnique m) => Cond -> Operand -> Operand -> BlockId -> m InstrBlock
    genCondFarJump :: forall (m :: * -> *).
    MonadGetUnique m =>
    Cond -> Operand -> Operand -> BlockId -> m (OrdList Instr)
    genCondFarJump Cond
    cond Operand
    op1 Operand
    op2 BlockId
    far_target = do
      skip_lbl_id <- m BlockId
    forall (m :: * -> *). MonadGetUnique m => m BlockId
    newBlockId
      jmp_lbl_id <- newBlockId

      -- TODO: We can improve this by inverting the condition
      -- but it's not quite trivial since we don't know if we
      -- need to consider float orderings.
      -- So we take the hit of the additional jump in the false
      -- case for now.
      return
        $ toOL
          [ ann (text "Conditional far jump to: " <> ppr far_target)
              $ BCOND cond op1 op2 (TBlock jmp_lbl_id),
            B (TBlock skip_lbl_id),
            NEWBLOCK jmp_lbl_id,
            LDR II64 (OpReg W64 tmpReg) (OpImm (ImmCLbl (blockLbl far_target))),
            B (TReg tmpReg),
            NEWBLOCK skip_lbl_id
          ]

    -- | An unconditional jump to a far target
    --
    -- By loading the far target into a register for the jump, we can address the
    -- whole memory range.
    genFarJump :: (MonadGetUnique m) => BlockId -> m InstrBlock
    genFarJump :: forall (m :: * -> *).
    MonadGetUnique m =>
    BlockId -> m (OrdList Instr)
    genFarJump BlockId
    far_target =
      OrdList Instr -> m (OrdList Instr)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        (OrdList Instr -> m (OrdList Instr))
    -> OrdList Instr -> m (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
          [ SDoc -> Instr -> Instr
    ann ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "Unconditional far jump to: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> BlockId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr BlockId
    far_target)
              (Instr -> Instr) -> Instr -> Instr
    forall a b. (a -> b) -> a -> b
    $ Format -> Operand -> Operand -> Instr
    LDR Format
    II64 (Width -> Reg -> Operand
    OpReg Width
    W64 Reg
    tmpReg) (Imm -> Operand
    OpImm (CLabel -> Imm
    ImmCLbl (BlockId -> CLabel
    blockLbl BlockId
    far_target))),
            Target -> Instr
    B (Reg -> Target
    TReg Reg
    tmpReg)
          ]

    -- See Note [RISCV64 far jumps]
    data BlockInRange = InRange | NotInRange BlockId

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

        -- 2^11, 12 bit immediate with one bit is reserved for the sign
        max_jump_dist :: Int
    max_jump_dist = Int
    2 Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ (Int
    11 :: Int) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 :: Int
        -- Currently all inline info tables fit into 64 bytes.
        max_info_size :: Int
    max_info_size = Int
    16 :: Int
        long_bc_jump_size :: Int
    long_bc_jump_size = Int
    5 :: Int
        long_b_jump_size :: Int
    long_b_jump_size = Int
    2 :: Int

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

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

        replace_jump :: LabelMap Int -> Int -> Instr -> UniqDSM (Int, [Instr])
        replace_jump :: LabelMap Int -> Int -> Instr -> UniqDSM (Int, [Instr])
    replace_jump !LabelMap Int
    m !Int
    pos Instr
    instr = do
          case Instr
    instr of
            ANN SDoc
    ann Instr
    instr -> do
              LabelMap Int -> Int -> Instr -> UniqDSM (Int, [Instr])
    replace_jump LabelMap Int
    m Int
    pos Instr
    instr UniqDSM (Int, [Instr])
    -> ((Int, [Instr]) -> UniqDSM (Int, [Instr]))
    -> UniqDSM (Int, [Instr])
    forall a b. UniqDSM a -> (a -> UniqDSM b) -> UniqDSM b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                (Int
    _, []) -> [Char] -> UniqDSM (Int, [Instr])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "RV64:replace_jump"
                (Int
    idx, Instr
    instr' : [Instr]
    instrs') ->
                  (Int, [Instr]) -> UniqDSM (Int, [Instr])
    forall a. a -> UniqDSM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    idx, SDoc -> Instr -> Instr
    ANN SDoc
    ann Instr
    instr' Instr -> [Instr] -> [Instr]
    forall a. a -> [a] -> [a]
    : [Instr]
    instrs')
            BCOND Cond
    cond Operand
    op1 Operand
    op2 Target
    t ->
              case LabelMap Int -> Target -> Int -> BlockInRange
    target_in_range LabelMap Int
    m Target
    t Int
    pos of
                BlockInRange
    InRange -> (Int, [Instr]) -> UniqDSM (Int, [Instr])
    forall a. a -> UniqDSM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    pos Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Instr -> Int
    instr_size Instr
    instr, [Instr
    instr])
                NotInRange BlockId
    far_target -> do
                  jmp_code <- Cond -> Operand -> Operand -> BlockId -> UniqDSM (OrdList Instr)
    forall (m :: * -> *).
    MonadGetUnique m =>
    Cond -> Operand -> Operand -> BlockId -> m (OrdList Instr)
    genCondFarJump Cond
    cond Operand
    op1 Operand
    op2 BlockId
    far_target
                  pure (pos + instr_size instr, fromOL jmp_code)
            B Target
    t ->
              case LabelMap Int -> Target -> Int -> BlockInRange
    target_in_range LabelMap Int
    m Target
    t Int
    pos of
                BlockInRange
    InRange -> (Int, [Instr]) -> UniqDSM (Int, [Instr])
    forall a. a -> UniqDSM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    pos Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Instr -> Int
    instr_size Instr
    instr, [Instr
    instr])
                NotInRange BlockId
    far_target -> do
                  jmp_code <- BlockId -> UniqDSM (OrdList Instr)
    forall (m :: * -> *).
    MonadGetUnique m =>
    BlockId -> m (OrdList Instr)
    genFarJump BlockId
    far_target
                  pure (pos + instr_size instr, fromOL jmp_code)
            Instr
    _ -> (Int, [Instr]) -> UniqDSM (Int, [Instr])
    forall a. a -> UniqDSM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    pos Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Instr -> Int
    instr_size Instr
    instr, [Instr
    instr])

        target_in_range :: LabelMap Int -> Target -> Int -> BlockInRange
        target_in_range :: LabelMap Int -> Target -> Int -> BlockInRange
    target_in_range LabelMap Int
    m Target
    target Int
    src =
          case Target
    target of
            (TReg {}) -> BlockInRange
    InRange
            (TBlock BlockId
    bid) -> LabelMap Int -> Int -> BlockId -> BlockInRange
    block_in_range LabelMap Int
    m Int
    src BlockId
    bid

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

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

        instr_pos :: (Int, LabelMap Int) -> Instr -> (Int, LabelMap Int)
        instr_pos :: (Int, LabelMap Int) -> Instr -> (Int, LabelMap Int)
    instr_pos (Int
    pos, LabelMap Int
    m) Instr
    instr = (Int
    pos Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Instr -> Int
    instr_size Instr
    instr, LabelMap Int
    m)

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

        instr_size :: Instr -> Int
        instr_size :: Instr -> Int
    instr_size Instr
    i = case Instr
    i of
          COMMENT {} -> Int
    0
          MULTILINE_COMMENT {} -> Int
    0
          ANN SDoc
    _ Instr
    instr -> Instr -> Int
    instr_size Instr
    instr
          LOCATION {} -> Int
    0
          DELTA {} -> Int
    0
          -- At this point there should be no NEWBLOCK in the instruction stream (pos, mapInsert bid pos m)
          NEWBLOCK {} -> [Char] -> Int
    forall a. HasCallStack => [Char] -> a
    panic [Char]
    "mkFarBranched - Unexpected"
          LDATA {} -> [Char] -> Int
    forall a. HasCallStack => [Char] -> a
    panic [Char]
    "mkFarBranched - Unexpected"
          Instr
    PUSH_STACK_FRAME -> Int
    4
          Instr
    POP_STACK_FRAME -> Int
    4
          ADD {} -> Int
    1
          MUL {} -> Int
    1
          MULH {} -> Int
    1
          NEG {} -> Int
    1
          DIV {} -> Int
    1
          REM {} -> Int
    1
          REMU {} -> Int
    1
          SUB {} -> Int
    1
          DIVU {} -> Int
    1
          AND {} -> Int
    1
          OR {} -> Int
    1
          SRA {} -> Int
    1
          XOR {} -> Int
    1
          SLL {} -> Int
    1
          SRL {} -> Int
    1
          MOV {} -> Int
    2
          ORI {} -> Int
    1
          XORI {} -> Int
    1
          CSET {} -> Int
    2
          STR {} -> Int
    1
          LDR {} -> Int
    3
          LDRU {} -> Int
    1
          FENCE {} -> Int
    1
          FCVT {} -> Int
    1
          FABS {} -> Int
    1
          FMIN {} -> Int
    1
          FMAX {} -> Int
    1
          FMA {} -> Int
    1
          -- estimate the subsituted size for jumps to lables
          -- jumps to registers have size 1
          BCOND {} -> Int
    long_bc_jump_size
          B (TBlock BlockId
    _) -> Int
    long_b_jump_size
          B (TReg Reg
    _) -> Int
    1
          J Target
    op -> Instr -> Int
    instr_size (Target -> Instr
    B Target
    op)
          BL Reg
    _ [Reg]
    _ -> Int
    1
          J_TBL {} -> Int
    1