content: {-# language GADTs #-}
  {-# language LambdaCase #-}
  {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE BinaryLiterals #-}
  {-# LANGUAGE OverloadedStrings #-}
  module GHC.CmmToAsm.LA64.CodeGen (
        cmmTopCodeGen
      , generateJumpTableForInstr
      , makeFarBranches
  )
  
  where
  
  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.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,
      getConfig,
      getDebugBlock,
      getFileId,
      getNewLabelNat,
      getNewRegNat,
      getPicBaseMaybeNat,
      getPlatform
    )
  import GHC.CmmToAsm.PIC
  import GHC.CmmToAsm.LA64.Cond
  import GHC.CmmToAsm.LA64.Instr
  import GHC.CmmToAsm.LA64.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.Utils.Constants (debugIsOn)
  import GHC.Utils.Misc
  import GHC.Utils.Outputable
  import GHC.Utils.Panic
  import GHC.Utils.Monad
  import Control.Monad
  import GHC.Cmm.Dataflow.Label
  import GHC.Types.Unique.DSM
  
  -- [General layout of an NCG]
  cmmTopCodeGen ::
    RawCmmDecl ->
    NatM [NatCmmDecl RawCmmStatics Instr]
  -- Thus we'll have to deal with either CmmProc ...
  cmmTopCodeGen _cmm@(CmmProc info lab live graph) = do
    picBaseMb <- getPicBaseMaybeNat
    when (isJust picBaseMb) $ panic "LA64.cmmTopCodeGen: Unexpected PIC base register"
  
    let blocks = toBlockListEntryFirst graph
    (nat_blocks, statics) <- mapAndUnzipM basicBlockCodeGen blocks
  
    let proc = CmmProc info lab live (ListGraph $ concat nat_blocks)
        tops = proc : concat statics
  
    pure tops
  
  -- ... or CmmData.
  cmmTopCodeGen (CmmData sec dat) = pure [CmmData sec dat] -- no translation, we just use CmmStatic
  
  basicBlockCodeGen ::
    Block CmmNode C C ->
    NatM
      ( [NatBasicBlock Instr],
        [NatCmmDecl RawCmmStatics Instr]
      )
  basicBlockCodeGen block = do
    config <- getConfig
    let (_, nodes, tail) = blockSplit block
        id = entryLabel block
        stmts = blockToList nodes
  
        header_comment_instr
          | debugIsOn =
              unitOL
                $ MULTILINE_COMMENT
                  ( text "-- --------------------------- basicBlockCodeGen --------------------------- --\n"
                      $+$ withPprStyle defaultDumpStyle (pdoc (ncgPlatform config) block)
                  )
          | otherwise = 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 = header_comment_instr `appOL` loc_instrs `appOL` mid_instrs `appOL` 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 = do
        dbg <- getDebugBlock (entryLabel block)
        case dblSourceTick =<< dbg of
          Just (SourceNote span name) ->
            do
              fileId <- getFileId (srcSpanFile span)
              let line = srcSpanStartLine span; col = srcSpanStartCol span
              pure $ unitOL $ LOCATION fileId line col name
          _ -> pure nilOL
  
  mkBlocks ::
    Instr ->
    ([Instr], [GenBasicBlock Instr], [GenCmmDecl RawCmmStatics h g]) ->
    ([Instr], [GenBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
  mkBlocks (NEWBLOCK id) (instrs, blocks, statics) =
    ([], BasicBlock id instrs : blocks, statics)
  mkBlocks (LDATA sec dat) (instrs, blocks, statics) =
    (instrs, blocks, CmmData sec dat : statics)
  mkBlocks instr (instrs, blocks, statics) =
    (instr : instrs, blocks, statics)
  
  -- -----------------------------------------------------------------------------
  -- | Utilities
  
  -- | Annotate an `Instr` with a `SDoc` comment
  ann :: SDoc -> Instr -> Instr
  ann doc instr {- debugIsOn -} = ANN doc 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 oculd be to have
  --
  --    (pprExpr genericPlatform e) <> parens (text. show e)
  --
  -- to have the best of both worlds.
  --
  -- Note: debugIsOn is too restrictive, it only works for debug compilers.
  -- However, we do not only want to inspect this for debug compilers. Ideally
  -- we'd have a check for -dppr-debug here already, such that we don't even
  -- generate the ANN expressions. However, as they are lazy, they shouldn't be
  -- forced until we actually force them, and without -dppr-debug they should
  -- never end up being forced.
  annExpr :: CmmExpr -> Instr -> Instr
  annExpr e {- debugIsOn -} = ANN (text . show $ e)
  -- annExpr e instr {- debugIsOn -} = ANN (pprExpr genericPlatform e) instr
  -- annExpr _ instr = instr
  {-# INLINE annExpr #-}
  
  -- -----------------------------------------------------------------------------
  -- Generating a table-branch
  -- The index into the jump table is calulated by evaluating @expr@. The
  -- corresponding table entry contains the address to jump to.
  genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM InstrBlock
  genSwitch config expr targets = do
    (reg, fmt1, e_code) <- getSomeReg indexExpr
    targetReg <- getNewRegNat II64
    lbl <- getNewLabelNat
    dynRef <- cmmMakeDynamicReference config DataReference lbl
    (tableReg, fmt2, t_code) <- getSomeReg $ dynRef
    let code =
          toOL [ COMMENT (text "indexExpr" <+> (text . show) indexExpr)
               , COMMENT (text "dynRef" <+> (text . show) dynRef)
               ]
            `appOL` e_code
            `appOL` t_code
            `appOL` toOL
              [
                COMMENT (ftext "Jump table for switch"),
                -- index to offset into the table (relative to tableReg)
                annExpr expr (SLL (OpReg W64 reg) (OpReg (formatToWidth fmt1) reg) (OpImm (ImmInt 3))),
                -- calculate table entry address
                ADD (OpReg W64 targetReg) (OpReg W64 reg) (OpReg (formatToWidth fmt2) tableReg),
                -- load table entry (relative offset from tableReg (first entry) to target label)
                LDU II64 (OpReg W64 targetReg) (OpAddr (AddrRegImm targetReg (ImmInt 0))),
                -- calculate absolute address of the target label
                ADD (OpReg W64 targetReg) (OpReg W64 targetReg) (OpReg W64 tableReg),
                -- prepare jump to target label
                J_TBL bids (Just lbl) targetReg
              ]
    return code
    where
      platform = ncgPlatform config
      expr_w = cmmExprWidth platform expr
      indexExpr0 = cmmOffset platform expr offset
      -- Widen to a native-width register(addressing modes)
      indexExpr = CmmMachOp
          (MO_UU_Conv expr_w (platformWordWidth platform))
          [indexExpr0]
      (offset, bids) = switchTargetsToTable targets
  
  
  -- Generate jump table data (if required)
  --
  -- Relies on PIC relocations. The idea is to emit one table entry per case. The
  -- entry is the label of the block to jump to. This will be relocated to be the
  -- address of the jump target.
  generateJumpTableForInstr ::
    NCGConfig ->
    Instr ->
    Maybe (NatCmmDecl RawCmmStatics Instr)
  generateJumpTableForInstr config (J_TBL ids (Just lbl) _) =
    let jumpTable =
          map jumpTableEntryRel ids
          where
            jumpTableEntryRel Nothing =
              CmmStaticLit (CmmInt 0 (ncgWordWidth config))
            jumpTableEntryRel (Just blockid) =
              CmmStaticLit
                ( CmmLabelDiffOff
                    blockLabel
                    lbl
                    0
                    (ncgWordWidth config)
                )
              where
                blockLabel = blockLbl blockid
     in Just (CmmData (Section ReadOnlyData lbl) (CmmStaticsRaw lbl jumpTable))
  generateJumpTableForInstr _ _ = Nothing
  
  -- -----------------------------------------------------------------------------
  -- Top-level of the instruction selector
  stmtsToInstrs ::
    -- | Cmm Statements
    [CmmNode O O] ->
    -- | Resulting instruction
    NatM InstrBlock
  stmtsToInstrs stmts = concatOL <$> mapM stmtToInstrs stmts
  
  stmtToInstrs ::
    CmmNode e x ->
    -- | Resulting instructions
    NatM InstrBlock
  
  stmtToInstrs stmt = do
    config <- getConfig
    platform <- getPlatform
    case stmt of
      CmmUnsafeForeignCall target result_regs args
        -> genCCall target result_regs args
  
      CmmComment s   -> return (unitOL (COMMENT (ftext s)))
      CmmTick {}     -> return nilOL
  
      CmmAssign reg src
        | isFloatType ty         -> assignReg_FltCode format reg src
        | otherwise              -> assignReg_IntCode format reg src
          where ty = cmmRegType reg
                format = cmmTypeFormat ty
  
      CmmStore addr src _alignment
        | isFloatType ty         -> assignMem_FltCode format addr src
        | otherwise              -> assignMem_IntCode format addr src
          where ty = cmmExprType platform src
                format = cmmTypeFormat ty
  
      CmmBranch id          -> genBranch 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 arg true false _prediction ->
          genCondBranch true false arg
  
      CmmSwitch arg ids -> genSwitch config arg ids
  
      CmmCall { cml_target = arg } -> genJump arg
  
      CmmUnwind _regs -> pure nilOL
  
      _ ->  pprPanic "stmtToInstrs: statement should have been cps'd away" (pdoc platform 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' (Fixed _ reg code) = Fixed format' reg code
  swizzleRegisterRep format' (Any _ codefn) = Any format' codefn
  
  -- | Grab a `Reg` for a `CmmReg`
  getRegisterReg :: Platform -> CmmReg -> Reg
  
  getRegisterReg _ (CmmLocal (LocalReg u pk))
    = RegVirtual $ mkVirtualReg u (cmmTypeFormat pk)
  
  getRegisterReg platform (CmmGlobal mid)
    = case globalRegMaybe platform (globalRegUse_reg mid) of
          Just reg -> RegReal reg
          Nothing  -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
  
  -- General things for putting together code sequences
  
  -- | Compute an expression into any register
  getSomeReg :: CmmExpr -> NatM (Reg, Format, InstrBlock)
  getSomeReg expr = do
    r <- getRegister expr
    case r of
      Any rep code -> do
          tmp <- getNewRegNat rep
          return (tmp, rep, code tmp)
      Fixed rep reg code ->
          return (reg, rep, code)
  
  -- | Compute an expression into any floating-point register
  
  -- | Compute an expression into 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 expr = do
    r <- getRegister expr
    case r of
      Any rep code | isFloatFormat rep -> do
        tmp <- getNewRegNat rep
        return (tmp, rep, code tmp)
      Any II32 code -> do
        tmp <- getNewRegNat FF32
        return (tmp, FF32, code tmp)
      Any II64 code -> do
        tmp <- getNewRegNat FF64
        return (tmp, FF64, code tmp)
      Any _w _code -> do
        config <- getConfig
        pprPanic "can't do getFloatReg on" (pdoc (ncgPlatform config) expr)
      -- can't do much for fixed.
      Fixed rep reg code ->
        return (reg, rep, code)
  
  -- | Map `CmmLit` to `OpImm`
  litToImm' :: CmmLit -> Operand
  litToImm' = OpImm . litToImm
  
  -- Handling PIC on LA64
  -- Commonly, `PIC` means of `position independent code`, that to say, the execution
  -- of code does not be influenced by Load_address. Through PC-Relative addressing
  -- or GOT addressing, both can be used to implement `PIC`.
  --
  -- For LoongArch's common compiler(GCC, Clang), they generate PIC code by default
  -- without condition. The command option `-fPIC` dicates to generate code for
  -- shared-library. If not just specified for shared-library, another option `-fPIE`
  -- was be created.
  --
  -- Like RV64, LA64 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.
  --
  -- LA64 assembly has many `la*` (load address) pseudo-instructions, that allows
  -- loading a symbols's address into a register. These instructions is desugared into
  -- different addressing modes. See following:
  --
  -- la        rd, label + addend  -> Load global symbol
  -- la.global rd, label + addend  -> Same as `la`
  -- la.local  rd, label + addend  -> Load local symbol
  -- la.pcrel  rd, label + addend
  -- la.got    rd, label
  -- la.abs    rd, label + addend
  --
  -- `la` is alias of `la.global`. Commonly recommended use `la.local` and `la.global`.
  --
  -- PC-relative addressing:
  --   pcalau12i $a0, %pc_hi20(a)
  --   addi.d    $a0, $a0, %pc_lo12(a)
  --
  -- GOT addressing:
  --   pcalau12i $a0, %got_pc_hi20(global_a)
  --   ld.d      $a0, $a0, %got_pc_lo12(global_a)
  --
  -- PIC can be enabled/disabled through:
  --  .option pic
  --
  -- 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 LA64. If
  -- we want to distinguish between symbol loading, we need to address this through
  -- the way we load it, not through a register.
  
  -- Compute a `CmmExpr` into a `Register`
  getRegister :: CmmExpr -> NatM Register
  getRegister e = do
    config <- getConfig
    getRegister' config (ncgPlatform config) e
  
  -- Signed arithmetic on LoongArch64
  --
  -- Handling signed arithmetic on sub-word-size values on LA64 is a bit tricky
  -- as Cmm's type system does not capture signedness. While 32- and 64-bit
  -- values are fairly easy to handle due to LA64's 32- and 64-bit instructions
  -- with responding register, 8- and 16-bit values require quite some care.
  --
  -- For LoongArch64, EXT.W.[B/H] will sign-extend 8- and 16-bit to 64-bit.
  -- However, it is best to use EXT instruction only if the input and
  -- output data widths are fully determined.
  --
  -- We handle 16-and 8-bit values by using the following two steps:
  --  1. Sign- or Zero-extending operands.
  --  2. 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.
  
  getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register
  
  -- OPTIMIZATION WARNING: CmmExpr rewrites
  
  -- Generic case.
  getRegister' config plat expr =
    case expr of
      CmmReg (CmmGlobal (GlobalRegUse PicBaseReg _)) ->
        pprPanic "getRegisterReg-memory" (ppr PicBaseReg)
  
      CmmLit lit ->
        case lit of
          CmmInt 0 w -> pure $ Fixed (intFormat w) zeroReg nilOL
          CmmInt i w -> do
            -- narrowU is important: Negative immediates may be
            -- sign-extended on load!
            let imm = OpImm . ImmInteger $ narrowU w i
            return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg w dst) imm)))
  
          CmmFloat 0 w -> do
            let op = litToImm' lit
            pure (Any (floatFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg w dst) op)))
  
          CmmFloat _f W8  -> pprPanic "getRegister' (CmmLit:CmmFloat), no support for bytes" (pdoc plat expr)
          CmmFloat _f W16 -> pprPanic "getRegister' (CmmLit:CmmFloat), no support for halfs" (pdoc plat expr)
  
          CmmFloat f W32 -> do
            let word = castFloatToWord32 (fromRational f) :: Word32
            tmp <- getNewRegNat (intFormat W32)
            return (Any (floatFormat W32) (\dst -> toOL [ annExpr expr
                                                        $ MOV (OpReg W32 tmp) (OpImm (ImmInteger (fromIntegral word)))
                                                        , MOV (OpReg W32 dst) (OpReg W32 tmp)
                                                        ]))
          CmmFloat f W64 -> do
            let word = castDoubleToWord64 (fromRational f) :: Word64
            tmp <- getNewRegNat (intFormat W64)
            return (Any (floatFormat W64) (\dst -> toOL [ annExpr expr
                                                        $ MOV (OpReg W64 tmp) (OpImm (ImmInteger (fromIntegral word)))
                                                        , MOV (OpReg W64 dst) (OpReg W64 tmp)
                                                        ]))
  
          CmmFloat _f _w -> pprPanic "getRegister' (CmmLit:CmmFloat), unsupported float lit" (pdoc plat expr)
          CmmVec _lits -> pprPanic "getRegister' (CmmLit:CmmVec): " (pdoc plat expr)
  
          CmmLabel lbl -> do
            let op = OpImm (ImmCLbl lbl)
                rep = cmmLitType plat lit
                format = cmmTypeFormat rep
            return (Any format (\dst -> unitOL $ annExpr expr (LD format (OpReg (formatToWidth format) dst) op)))
  
          CmmLabelOff lbl off | isNbitEncodeable 12 (fromIntegral off) -> do
            let op = OpImm (ImmIndex lbl off)
                rep = cmmLitType plat lit
                format = cmmTypeFormat rep
            return (Any format (\dst -> unitOL $ LD format (OpReg (formatToWidth format) dst) op))
  
          CmmLabelOff lbl off -> do
            let op = litToImm' (CmmLabel lbl)
                rep = cmmLitType plat lit
                format = cmmTypeFormat rep
                width = typeWidth rep
            (off_r, _off_format, off_code) <- getSomeReg $ CmmLit (CmmInt (fromIntegral off) width)
            return (Any format (\dst -> off_code `snocOL`
                                                  LD format (OpReg (formatToWidth format) dst) op `snocOL`
                                                  ADD (OpReg W64 dst) (OpReg width dst) (OpReg width off_r)
                               ))
  
          CmmLabelDiffOff {} -> pprPanic "getRegister' (CmmLit:CmmLabelOff): " (pdoc plat expr)
          CmmBlock _ -> pprPanic "getRegister' (CmmLit:CmmLabelOff): " (pdoc plat expr)
          CmmHighStackMark -> pprPanic "getRegister' (CmmLit:CmmLabelOff): " (pdoc plat expr)
  
      CmmLoad mem rep _ -> do
        let format = cmmTypeFormat rep
            width = typeWidth rep
        Amode addr addr_code <- getAmode plat width mem
        case width of
          w | w `elem` [W8, W16, W32, W64] ->
              -- Load without sign-extension.
              pure (Any format (\dst ->
                addr_code `snocOL`
                LDU format (OpReg width dst) (OpAddr addr))
                                )
          _ -> pprPanic ("Unknown width to load: " ++ show width) (pdoc plat expr)
  
      CmmStackSlot _ _  -> pprPanic "getRegister' (CmmStackSlot): " (pdoc plat expr)
  
      CmmReg reg -> return (Fixed (cmmTypeFormat (cmmRegType reg))
                                  (getRegisterReg plat reg)
                                  nilOL
                           )
  
      CmmRegOff reg off | isNbitEncodeable 12 (fromIntegral off) -> do
        getRegister' config plat
          $ CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]
        where
          width = typeWidth (cmmRegType reg)
      CmmRegOff reg off -> do
        (off_r, _off_format, off_code) <- getSomeReg $ CmmLit (CmmInt (fromIntegral off) width)
        (reg, _format, code) <- getSomeReg $ CmmReg reg
        return $ Any (intFormat width) ( \dst ->
                                          off_code `appOL`
                                          code `snocOL`
                                          ADD (OpReg W64 dst) (OpReg width reg) (OpReg width off_r)
                                       )
        where
          width = typeWidth (cmmRegType reg)
  
      -- Handle MO_RelaxedRead as a normal CmmLoad, to allow
      -- non-trivial addressing modes to be used.
      CmmMachOp (MO_RelaxedRead w) [e] ->
        getRegister (CmmLoad e (cmmBits w) NaturallyAligned)
  
      -- for MachOps, see GHC.Cmm.MachOp
      -- For CmmMachOp, see GHC.Cmm.Expr
      CmmMachOp op [e] -> do
        (reg, format, code) <- getSomeReg e
        case op of
          MO_Not w -> return $ Any (intFormat w) $ \dst ->
            code `appOL`
            -- pseudo instruction `not dst rd` is `nor dst, r0, rd`
            truncateReg (formatToWidth format) W64 reg `snocOL`
            -- At this point an 8- or 16-bit value would be zero-extended
            -- to 64-bits. Truncate back down the final width.
            ann (text "not") (NOR (OpReg W64 dst) (OpReg W64 reg) zero) `appOL`
            truncateReg W64 w dst
  
          MO_S_Neg w -> negate code w reg
          MO_F_Neg w -> return $ Any (floatFormat w) (\dst -> code `snocOL` FNEG (OpReg w dst) (OpReg w reg))
  
          -- Floating convertion oprations
          -- Float -> Float
          MO_FF_Conv from to -> return $ Any (floatFormat to) (\dst -> code `snocOL` FCVT (OpReg to dst) (OpReg from reg))
  
          -- Signed int -> Float
          MO_SF_Round from to -> return $ Any (floatFormat to) (\dst -> code `snocOL` SCVTF (OpReg to dst) (OpReg from reg))
  
          -- Float -> Signed int
          MO_FS_Truncate from to | from == W32 -> do
              tmp <- getNewRegNat FF32
              return $ Any (intFormat to) (\dst -> code `snocOL` FCVTZS (OpReg to dst) (OpReg from tmp) (OpReg from reg))
  
          MO_FS_Truncate from to | from == W64-> do
              tmp <- getNewRegNat FF64
              return $ Any (intFormat to) (\dst -> code `snocOL` FCVTZS (OpReg to dst) (OpReg from tmp) (OpReg from reg))
  
          -- unsigned int -> unsigned int
          MO_UU_Conv from to -> return $ Any (intFormat to) (\dst ->
            code `snocOL` BSTRPICK II64 (OpReg W64 dst) (OpReg W64 reg) (OpImm (ImmInt (widthToInt (min from to) - 1))) (OpImm (ImmInt 0))
                                                            )
  
          -- Signed int -> Signed int
          MO_SS_Conv from to -> ss_conv from to reg code
  
          -- int -> int
          MO_XX_Conv _from to -> swizzleRegisterRep (intFormat to) <$> getRegister e
  
          MO_WF_Bitcast w    -> return $ Any (floatFormat w)  (\dst -> code `snocOL` MOV (OpReg w dst) (OpReg w reg))
          MO_FW_Bitcast w    -> return $ Any (intFormat w)    (\dst -> code `snocOL` MOV (OpReg w dst) (OpReg w reg))
  
          x -> pprPanic ("getRegister' (monadic CmmMachOp): " ++ show x) (pdoc plat expr)
        where
          -- In the case of 32- or 16- or 8-bit values we need to sign-extend to 64-bits
          negate code w reg
            | w `elem` [W8, W16] = do
              return $ Any (intFormat w) $ \dst ->
                  code `snocOL`
                  EXT (OpReg W64 reg) (OpReg w reg) `snocOL`
                  NEG (OpReg W64 dst) (OpReg W64 reg) `appOL`
                  truncateReg W64 w dst
            | otherwise = do
              return $ Any (intFormat w) $ \dst ->
                  code `snocOL`
                  NEG (OpReg W64 dst) (OpReg w reg)
  
          ss_conv from to reg code
            | from `elem` [W8, W16] || to `elem` [W8, W16] = do
              return $ Any (intFormat to) $ \dst ->
                  code `snocOL`
                  EXT (OpReg W64 dst) (OpReg (min from to) reg) `appOL`
                  -- At this point an 8- or 16-bit value would be sign-extended
                  -- to 64-bits. Truncate back down the final width.
                  truncateReg W64 to dst
            | from == W32 && to == W64 = do
              return $ Any (intFormat to) $ \dst ->
                  code `snocOL`
                  SLL (OpReg to dst) (OpReg from reg) (OpImm (ImmInt 0))
            | from == to = do
              return $ Any (intFormat from) $ \dst ->
                   code `snocOL` MOV (OpReg from dst) (OpReg from reg)
            | otherwise = do
              return $ Any (intFormat to) $ \dst ->
                  code `appOL`
                  signExtend from W64 reg dst `appOL`
                  truncateReg W64 to dst
  
  
  -- Dyadic machops:
      --
      -- The general idea is:
      -- compute x<i> <- x
      -- compute x<j> <- y
      -- OP x<r>, x<i>, x<j>
      --
      -- TODO: for now we'll only implement the 64bit versions. And rely on the
      --      fallthrough to alert us if things go wrong!
      -- OPTIMIZATION WARNING: Dyadic CmmMachOp destructuring
      -- 0. TODO This should not exist! Rewrite: Reg +- 0 -> Reg
      CmmMachOp (MO_Add _) [expr'@(CmmReg (CmmGlobal _r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr'
      CmmMachOp (MO_Sub _) [expr'@(CmmReg (CmmGlobal _r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr'
  
      CmmMachOp (MO_Add w) [x, CmmLit (CmmInt n _)] | fitsInNbits 12 (fromIntegral n) -> do
        if w `elem` [W8, W16]
          then do
            (reg_x, _format_x, code_x) <- getSomeReg x
            return $ Any (intFormat w) (\dst ->
                                          code_x `snocOL`
                                          annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL`
                                          ADD (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n))
                                       )
          else do
            (reg_x, _format_x, code_x) <- getSomeReg x
            return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (ADD (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
  
      CmmMachOp (MO_Sub w) [x, CmmLit (CmmInt n _)] | fitsInNbits 12 (fromIntegral n) -> do
        if w `elem` [W8, W16]
          then do
            (reg_x, _format_x, code_x) <- getSomeReg x
            return $ Any (intFormat w) (\dst ->
                                          code_x `snocOL`
                                          annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL`
                                          SUB (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n))
                                       )
          else do
            (reg_x, _format_x, code_x) <- getSomeReg x
            return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SUB (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
  
      CmmMachOp (MO_U_Quot w) [x, y]
        | w `elem` [W8, W16] -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) (\dst ->
                                        code_x `appOL`
                                        code_y `appOL`
                                        truncateReg w W64 reg_x `appOL`
                                        truncateReg w W64 reg_y `snocOL`
                                        annExpr expr (DIVU (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
  
      -- 2. Shifts.
      CmmMachOp (MO_Shl w) [x, y] ->
        case y of
          CmmLit (CmmInt n _) | w `elem` [W8, W16], 0 <= n, n < fromIntegral (widthInBits w) -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            return $ Any (intFormat w) (\dst ->
                                          code_x `snocOL`
                                          annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL`
                                          SLL (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n))
                                       )
          CmmLit (CmmInt n _) | 0 <= n, n < fromIntegral (widthInBits w) -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SLL (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
  
          _ | w `elem` [W8, W16] -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            (reg_y, _format_y, code_y) <- getSomeReg y
            return $ Any (intFormat w) (\dst ->
                                          code_x `appOL`
                                          code_y `snocOL`
                                          annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL`
                                          EXT (OpReg W64 reg_y) (OpReg w reg_y) `snocOL`
                                          SLL (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)
                                       )
          _ -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            (reg_y, _format_y, code_y) <- getSomeReg y
            return $ Any (intFormat w) (\dst ->
                                          code_x `appOL`
                                          code_y `snocOL`
                                          annExpr expr (SLL (OpReg W64 dst) (OpReg w reg_x) (OpReg w reg_y))
                                       )
  
      -- MO_S_Shr: signed-shift-right
      CmmMachOp (MO_S_Shr w) [x, y] ->
        case y of
          CmmLit (CmmInt n _) | w `elem` [W8, W16], 0 <= n, n < fromIntegral (widthInBits w) -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            return $ Any (intFormat w)  (\dst ->
                                          code_x `snocOL`
                                          annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL`
                                          SRA (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n))
                                        )
          CmmLit (CmmInt n _) | 0 <= n, n < fromIntegral (widthInBits w) -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SRA (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
  
          _ | w `elem` [W8, W16] -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            (reg_y, _format_y, code_y) <- getSomeReg y
            return $ Any (intFormat w) (\dst ->
                                          code_x `appOL`
                                          code_y `snocOL`
                                          annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL`
                                          EXT (OpReg W64 reg_y) (OpReg w reg_y) `snocOL`
                                          SRA (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)
                                       )
          _ -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            (reg_y, _format_y, code_y) <- getSomeReg y
            return $ Any (intFormat w) (\dst ->
                                          code_x `appOL`
                                          code_y `snocOL`
                                          annExpr expr (SRA (OpReg W64 dst) (OpReg w reg_x) (OpReg w reg_y))
                                       )
  
      -- MO_U_Shr: unsigned-shift-right
      CmmMachOp (MO_U_Shr w) [x, y] ->
        case y of
          CmmLit (CmmInt n _) | w `elem` [W8, W16], 0 <= n, n < fromIntegral (widthInBits w) -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            return $ Any (intFormat w) (\dst ->
                                          code_x `appOL`
                                          truncateReg w W64 reg_x `snocOL`
                                          annExpr expr (SRL (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)))
                                       )
          CmmLit (CmmInt n _) | 0 <= n, n < fromIntegral (widthInBits w) -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SRL (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
  
          _ | w `elem` [W8, W16] -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            (reg_y, _format_y, code_y) <- getSomeReg y
            return $ Any (intFormat w) (\dst ->
                                          code_x `appOL`
                                          code_y `appOL`
                                          truncateReg w W64 reg_x `appOL`
                                          truncateReg w W64 reg_y `snocOL`
                                          annExpr expr (SRL (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                       )
          _ -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            (reg_y, _format_y, code_y) <- getSomeReg y
            return $ Any (intFormat w) (\dst ->
                                          code_x `appOL`
                                          code_y `snocOL`
                                          annExpr expr (SRL (OpReg W64 dst) (OpReg w reg_x) (OpReg w reg_y))
                                       )
  
      -- 3. Logic &&, ||
      -- andi Instr's Imm-operand is zero-extended.
      CmmMachOp (MO_And w) [x, y] ->
        case y of
          CmmLit (CmmInt n _) | w `elem` [W8, W16, W32], (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            return $ Any (intFormat w) (\dst ->
                                          code_x `appOL`
                                          truncateReg w W64 reg_x `snocOL`
                                          annExpr expr (AND (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)))
                                       )
  
          CmmLit (CmmInt n _) | (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (AND (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
  
          CmmLit (CmmInt n _) | w `elem` [W8, W16, W32] -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            tmp <- getNewRegNat II64
            return $ Any (intFormat w) (\dst ->
                                         code_x `appOL`
                                         truncateReg w W64 reg_x `snocOL`
                                         annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger n))) `snocOL`
                                         AND (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 tmp)
                                       )
  
          CmmLit (CmmInt n _) -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            tmp <- getNewRegNat II64
            return $ Any (intFormat w) (\dst ->
                                          code_x `snocOL`
                                          annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger  n))) `snocOL`
                                          AND (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 tmp)
                                       )
  
          _ | w `elem` [W8, W16, W32] -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            (reg_y, _format_y, code_y) <- getSomeReg y
            return $ Any (intFormat w) (\dst ->
                                          code_x `appOL`
                                          code_y `appOL`
                                          truncateReg w W64 reg_x `appOL`
                                          truncateReg w W64 reg_y `snocOL`
                                          annExpr expr (AND (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                       )
  
          _ -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            (reg_y, _format_y, code_y) <- getSomeReg y
            return $ Any (intFormat w) (\dst ->
                                          code_x `appOL`
                                          code_y `snocOL`
                                          annExpr expr (AND (OpReg W64 dst) (OpReg w reg_x) (OpReg w reg_y))
                                       )
  
      -- ori Instr's Imm-operand is zero-extended.
      CmmMachOp (MO_Or w) [x, y] ->
        case y of
          CmmLit (CmmInt n _) | w `elem` [W8, W16, W32], (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            return $ Any (intFormat w) (\dst ->
                                          code_x `appOL`
                                          truncateReg w W64 reg_x `snocOL`
                                          annExpr expr (OR (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)))
                                       )
  
          CmmLit (CmmInt n _) | (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (OR (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
  
          CmmLit (CmmInt n _) | w `elem` [W8, W16, W32] -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            tmp <- getNewRegNat II64
            return $ Any (intFormat w) (\dst ->
                                         code_x `appOL`
                                         truncateReg w W64 reg_x `snocOL`
                                         annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger n))) `snocOL`
                                         OR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 tmp)
                                       )
  
          CmmLit (CmmInt n _) -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            tmp <- getNewRegNat II64
            return $ Any (intFormat w) (\dst ->
                                          code_x `snocOL`
                                          annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger  n))) `snocOL`
                                          OR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 tmp)
                                       )
  
          _ | w `elem` [W8, W16, W32] -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            (reg_y, _format_y, code_y) <- getSomeReg y
            return $ Any (intFormat w) (\dst ->
                                          code_x `appOL`
                                          code_y `appOL`
                                          truncateReg w W64 reg_x `appOL`
                                          truncateReg w W64 reg_y `snocOL`
                                          annExpr expr (OR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                       )
  
          _ -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            (reg_y, _format_y, code_y) <- getSomeReg y
            return $ Any (intFormat w) (\dst ->
                                          code_x `appOL`
                                          code_y `snocOL`
                                          annExpr expr (OR (OpReg W64 dst) (OpReg w reg_x) (OpReg w reg_y))
                                       )
  
      -- xori Instr's Imm-operand is zero-extended.
      CmmMachOp (MO_Xor w) [x, y] ->
        case y of
          CmmLit (CmmInt n _) | w `elem` [W8, W16, W32], (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            return $ Any (intFormat w) (\dst ->
                                          code_x `appOL`
                                          truncateReg w W64 reg_x `snocOL`
                                          annExpr expr (XOR (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)))
                                       )
  
          CmmLit (CmmInt n _) | (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (XOR (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
  
          CmmLit (CmmInt n _) | w `elem` [W8, W16, W32] -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            tmp <- getNewRegNat II64
            return $ Any (intFormat w) (\dst ->
                                         code_x `appOL`
                                         truncateReg w W64 reg_x `snocOL`
                                         annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger n))) `snocOL`
                                         XOR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 tmp)
                                       )
  
          CmmLit (CmmInt n _) -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            tmp <- getNewRegNat II64
            return $ Any (intFormat w) (\dst ->
                                          code_x `snocOL`
                                          annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger  n))) `snocOL`
                                          XOR (OpReg W64 dst) (OpReg w reg_x) (OpReg W64 tmp)
                                       )
  
          _ | w `elem` [W8, W16, W32] -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            (reg_y, _format_y, code_y) <- getSomeReg y
            return $ Any (intFormat w) (\dst ->
                                          code_x `appOL`
                                          code_y `appOL`
                                          truncateReg w W64 reg_x `appOL`
                                          truncateReg w W64 reg_y `snocOL`
                                          annExpr expr (XOR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                       )
  
          _ -> do
            (reg_x, _format_x, code_x) <- getSomeReg x
            (reg_y, _format_y, code_y) <- getSomeReg y
            return $ Any (intFormat w) (\dst ->
                                          code_x `appOL`
                                          code_y `snocOL`
                                          annExpr expr (XOR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                       )
  
      -- CSET commands register operand being W64.
      CmmMachOp (MO_Eq w) [x, y]
        | w `elem` [W8, W16, W32] -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `appOL`
                                        signExtend w W64 reg_x reg_x `appOL`
                                        signExtend w W64 reg_y reg_y `snocOL`
                                        annExpr expr (CSET EQ (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
         | otherwise -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `snocOL`
                                        annExpr expr (CSET EQ (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
  
      CmmMachOp (MO_Ne w) [x, y]
        | w `elem` [W8, W16, W32] -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `appOL`
                                        signExtend w W64 reg_x reg_x `appOL`
                                        signExtend w W64 reg_y reg_y `snocOL`
                                        annExpr expr (CSET NE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
        | otherwise -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `snocOL`
                                        annExpr expr (CSET NE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
  
      CmmMachOp (MO_S_Lt w) [x, CmmLit (CmmInt n _)]
        | w `elem` [W8, W16, W32]
        , fitsInNbits 12 (fromIntegral n) -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        signExtend w W64 reg_x reg_x `snocOL`
                                        annExpr expr (SSLT (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)))
                                     )
        | fitsInNbits 12 (fromIntegral n) -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          return $ Any (intFormat w) ( \dst -> code_x `snocOL` annExpr expr (SSLT (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n))))
  
      CmmMachOp (MO_U_Lt w) [x, CmmLit (CmmInt n _)]
        | w `elem` [W8, W16, W32]
        , fitsInNbits 12 (fromIntegral n) -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        truncateReg w W64 reg_x `snocOL`
                                        annExpr expr (SSLTU (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)))
                                     )
        | fitsInNbits 12 (fromIntegral n) -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          return $ Any (intFormat w) ( \dst -> code_x `snocOL` annExpr expr (SSLTU (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger  n))))
  
      CmmMachOp (MO_S_Lt w) [x, y]
        | w `elem` [W8, W16, W32] -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `appOL`
                                        signExtend w W64 reg_x reg_x `appOL`
                                        signExtend w W64 reg_y reg_y `snocOL`
                                        annExpr expr (CSET SLT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
        | otherwise -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `snocOL`
                                        annExpr expr (CSET SLT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
  
      CmmMachOp (MO_S_Le w) [x, y]
        | w `elem` [W8, W16, W32] -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `appOL`
                                        signExtend w W64 reg_x reg_x `appOL`
                                        signExtend w W64 reg_y reg_y `snocOL`
                                        annExpr expr (CSET SLE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
        | otherwise -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `snocOL`
                                        annExpr expr (CSET SLE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
  
      CmmMachOp (MO_S_Ge w) [x, y]
        | w `elem` [W8, W16, W32] -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `appOL`
                                        signExtend w W64 reg_x reg_x `appOL`
                                        signExtend w W64 reg_y reg_y `snocOL`
                                        annExpr expr (CSET SGE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
        | otherwise -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `snocOL`
                                        annExpr expr (CSET SGE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
  
      CmmMachOp (MO_S_Gt w) [x, y]
        | w `elem` [W8, W16, W32] -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `appOL`
                                        signExtend w W64 reg_x reg_x `appOL`
                                        signExtend w W64 reg_y reg_y `snocOL`
                                        annExpr expr (CSET SGT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
        | otherwise -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `snocOL`
                                        annExpr expr (CSET SGT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
  
      CmmMachOp (MO_U_Lt w) [x, y]
        | w `elem` [W8, W16, W32] -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `appOL`
                                        truncateReg w W64 reg_x `appOL`
                                        truncateReg w W64 reg_y `snocOL`
                                        annExpr expr (CSET ULT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
        | otherwise -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `snocOL`
                                        annExpr expr (CSET ULT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
  
      CmmMachOp (MO_U_Le w) [x, y]
        | w `elem` [W8, W16, W32] -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `appOL`
                                        truncateReg w W64 reg_x `appOL`
                                        truncateReg w W64 reg_y `snocOL`
                                        annExpr expr (CSET ULE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
        | otherwise -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `snocOL`
                                        annExpr expr (CSET ULE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
  
      CmmMachOp (MO_U_Ge w) [x, y]
        | w `elem` [W8, W16, W32] -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `appOL`
                                        truncateReg w W64 reg_x `appOL`
                                        truncateReg w W64 reg_y `snocOL`
                                        annExpr expr (CSET UGE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
        | otherwise -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `snocOL`
                                        annExpr expr (CSET UGE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
  
      CmmMachOp (MO_U_Gt w) [x, y]
        | w `elem` [W8, W16, W32] -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `appOL`
                                        truncateReg w W64 reg_x `appOL`
                                        truncateReg w W64 reg_y `snocOL`
                                        annExpr expr (CSET UGT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
        | otherwise -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          return $ Any (intFormat w) ( \dst ->
                                        code_x `appOL`
                                        code_y `snocOL`
                                        annExpr expr (CSET UGT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y))
                                     )
  
  
      -- Generic binary case.
      CmmMachOp op [x, y] -> do
        let
            -- A (potentially signed) integer operation.
            -- In the case of 8-, 16- and 32-bit signed arithmetic we must first
            -- sign-extend all arguments to 64-bits.
            -- TODO: can be simplified.
            intOp is_signed w op = do
                -- compute x<m> <- x
                -- compute x<o> <- y
                -- <OP> x<n>, x<m>, x<o>
                (reg_x, format_x, code_x) <- getSomeReg x
                (reg_y, format_y, code_y) <- getSomeReg y
                massertPpr (isIntFormat format_x && isIntFormat format_y) $ text "intOp: non-int"
                let w' = W64
                -- This is the width of the registers on which the operation
                -- should be performed.
                if not is_signed
                  then return $ Any (intFormat w) $ \dst ->
                        code_x `appOL`
                        code_y `appOL`
                        -- zero-extend both operands
                        truncateReg (formatToWidth format_x) w' reg_x `appOL`
                        truncateReg (formatToWidth format_y) w' reg_y `snocOL`
                        op (OpReg w' dst) (OpReg w' reg_x) (OpReg w' reg_y) `appOL`
                        truncateReg w' w dst -- truncate back to the operand's original width
                  else return $ Any (intFormat w) $ \dst ->
                        code_x `appOL`
                        code_y `appOL`
                        -- sign-extend both operands
                        signExtend (formatToWidth format_x) W64 reg_x reg_x `appOL`
                        signExtend (formatToWidth format_x) W64 reg_y reg_y `snocOL`
                        op (OpReg w' dst) (OpReg w' reg_x) (OpReg w' reg_y) `appOL`
                        truncateReg w' w dst -- truncate back to the operand's original width
  
            floatOp w op = do
              (reg_fx, format_x, code_fx) <- getFloatReg x
              (reg_fy, format_y, code_fy) <- getFloatReg y
              massertPpr (isFloatFormat format_x && isFloatFormat format_y) $ text "floatOp: non-float"
              return $ Any (floatFormat w) (\dst -> code_fx `appOL` code_fy `appOL` op (OpReg w dst) (OpReg w reg_fx) (OpReg w reg_fy))
  
            -- need a special one for conditionals, as they return ints
            floatCond w op = do
              (reg_fx, format_x, code_fx) <- getFloatReg x
              (reg_fy, format_y, code_fy) <- getFloatReg y
              massertPpr (isFloatFormat format_x && isFloatFormat format_y) $ text "floatCond: non-float"
              return $ Any (intFormat w) (\dst -> code_fx `appOL` code_fy `appOL` op (OpReg w dst) (OpReg w reg_fx) (OpReg w reg_fy))
  
        case op of
          -- Integer operations
          -- Add/Sub should only be Integer Options.
          MO_Add w -> intOp False w (\d x y ->  annExpr expr (ADD d x y))
          MO_Sub w -> intOp False w (\d x y ->  annExpr expr (SUB d x y))
  
          -- Signed multiply/divide/remain
          MO_Mul w          -> intOp True w (\d x y -> annExpr expr (MUL d x y))
          MO_S_MulMayOflo w -> do_mul_may_oflo w x y
  
          MO_S_Quot w  -> intOp True w (\d x y -> annExpr expr (DIV d x y))
          MO_S_Rem w   -> intOp True w (\d x y -> annExpr expr (MOD d x y))
  
          -- Unsigned divide/remain
          MO_U_Quot w  -> intOp False w (\d x y -> annExpr expr (DIVU d x y))
          MO_U_Rem w   -> intOp False w (\d x y -> annExpr expr (MODU d x y))
  
          -- Floating point arithmetic
          MO_F_Add w   -> floatOp w (\d x y -> unitOL $ annExpr expr (ADD d x y))
          MO_F_Sub w   -> floatOp w (\d x y -> unitOL $ annExpr expr (SUB d x y))
          MO_F_Mul w   -> floatOp w (\d x y -> unitOL $ annExpr expr (MUL d x y))
          MO_F_Quot w  -> floatOp w (\d x y -> unitOL $ annExpr expr (DIV d x y))
          MO_F_Min w   -> floatOp w (\d x y -> unitOL $ annExpr expr (FMIN d x y))
          MO_F_Max w   -> floatOp w (\d x y -> unitOL $ annExpr expr (FMAX d x y))
  
          -- Floating point comparison
          MO_F_Eq w    -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET EQ d x y))
          MO_F_Ne w    -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET NE d x y))
          MO_F_Ge w    -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET FGE d x y))
          MO_F_Le w    -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET FLE d x y))
          MO_F_Gt w    -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET FGT d x y))
          MO_F_Lt w    -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET FLT d x y))
  
          op -> pprPanic "getRegister' (unhandled dyadic CmmMachOp): " $ pprMachOp op <+> text "in" <+> pdoc plat expr
  
      -- Generic ternary case.
      CmmMachOp op [x, y, z] ->
        case op of
  
          -- Floating-point fused multiply-add operations
          MO_FMA var l w
            | l == 1
            -> case var of
              FMAdd  -> float3Op w (\d n m a -> unitOL $ FMA FMAdd  d n m a)
              FMSub  -> float3Op w (\d n m a -> unitOL $ FMA FMSub d n m a)
              FNMAdd -> float3Op w (\d n m a -> unitOL $ FMA FNMSub  d n m a)
              FNMSub -> float3Op w (\d n m a -> unitOL $ FMA FNMAdd d n m a)
            | otherwise
            -> sorry "The RISCV64 backend does not (yet) support vectors."
  
          _ -> pprPanic "getRegister' (unhandled ternary CmmMachOp): " $ (pprMachOp op) <+> text "in" <+> (pdoc plat expr)
  
        where
            float3Op w op = do
              (reg_fx, format_x, code_fx) <- getFloatReg 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) $ \ dst ->
                  code_fx `appOL`
                  code_fy `appOL`
                  code_fz `appOL`
                  op (OpReg w dst) (OpReg w reg_fx) (OpReg w reg_fy) (OpReg w reg_fz)
  
      CmmMachOp _op _xs
        -> pprPanic "getRegister' (variadic CmmMachOp): " (pdoc plat expr)
  
    where
      -- 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 W64 x y = do
        (reg_x, _format_x, code_x) <- getSomeReg x
        (reg_y, _format_y, code_y) <- getSomeReg y
        lo <- getNewRegNat II64
        hi <- getNewRegNat II64
        return $ Any (intFormat W64) (\dst ->
          code_x `appOL`
          code_y `snocOL`
          MULH (OpReg W64 hi) (OpReg W64 reg_x)  (OpReg W64 reg_y) `snocOL`
          MUL  (OpReg W64 lo) (OpReg W64 reg_x)  (OpReg W64 reg_y) `snocOL`
          SRA  (OpReg W64 lo) (OpReg W64 lo)     (OpImm (ImmInt 63)) `snocOL`
          CSET NE (OpReg W64 dst) (OpReg W64 hi)  (OpReg W64 lo)
                                   )
  
      do_mul_may_oflo W32 x y = do
          (reg_x, _format_x, code_x) <- getSomeReg x
          (reg_y, _format_y, code_y) <- getSomeReg y
          tmp1 <- getNewRegNat II64
          tmp2 <- getNewRegNat II64
          return $ Any (intFormat W32) (\dst ->
              code_x `appOL`
              code_y `snocOL`
              MULW (OpReg W64 tmp1) (OpReg W64 reg_x) (OpReg W64 reg_y) `snocOL`
              ADD (OpReg W64 tmp2) (OpReg W32 tmp1) (OpImm (ImmInt 0)) `snocOL`
              CSET NE (OpReg W64 dst) (OpReg W64 tmp1)  (OpReg W64 tmp2)
                                       )
  
      -- General case
      do_mul_may_oflo w x y = do
        -- Assert: 8bit * 8bit cannot overflow 16bit, and so on.
        (reg_x, format_x, code_x) <- getSomeReg x
        (reg_y, format_y, code_y) <- getSomeReg y
        tmp1 <- getNewRegNat II64
        tmp2 <- getNewRegNat II64
        let width_x = formatToWidth format_x
            width_y = formatToWidth format_y
            extend dst src =
              case w of
                W8  -> SLL (OpReg W64 dst) (OpReg W32 src) (OpImm (ImmInt 0))
                W16 -> SLL (OpReg W64 dst) (OpReg W32 src) (OpImm (ImmInt 0))
                _   -> panic "Must be in [W8, W16, W32]!"
            extract width dst src =
              case width of
                W8  -> EXT (OpReg W64 dst) (OpReg W8 src)
                W16 -> EXT (OpReg W64 dst) (OpReg W16 src)
                W32 -> SLL (OpReg W64 dst) (OpReg W32 src) (OpImm (ImmInt 0))
                _   -> panic "Must be in [W8, W16, W32]!"
  
        case w of
          w | (width_x < w) && (width_y < w) ->
            return $ Any (intFormat w) ( \dst ->
              unitOL $ annExpr expr (MOV (OpReg w dst) (OpImm (ImmInt 0)))
                                       )
          w | w <= W32 && width_x <= W32 && width_y <= W32 ->
              return $ Any (intFormat W32) (\dst ->
                  code_x `appOL`
                  code_y `appOL`
                  -- signExtend [W8, W16] register to W64 and then SLL
                  -- nil for W32
                  signExtend (formatToWidth format_x) W64 reg_x reg_x `appOL`
                  signExtend (formatToWidth format_y) W64 reg_y reg_y `snocOL`
                  extend reg_x reg_x `snocOL`
                  extend reg_y reg_y `snocOL`
                  -- 64-bits MUL
                  MUL (OpReg W64 tmp1) (OpReg W64 reg_x) (OpReg W64 reg_y) `snocOL`
                  -- extract valid result via result's width
                  -- slli.w for W32, otherwise ext.w.[b, h]
                  extract w tmp2 tmp1 `snocOL`
                  CSET NE (OpReg W64 dst) (OpReg W64 tmp1)  (OpReg W64 tmp2)
                                          )
  
          -- Should it be happened?
          _ ->
            return $ Any (intFormat w) ( \dst ->
              unitOL $ annExpr expr (MOV (OpReg w dst) (OpImm (ImmInt 1))))
  
  -- Sign-extend the value in the given register from width @w@
  -- up to width @w'@.
  -- TODO: Is there room for optimization?
  signExtend :: Width -> Width -> Reg -> Reg -> OrdList Instr
  signExtend w w' r r'
    | w > w' = pprPanic "Sign-extend Error: not a sign extension, but a truncation." $ ppr w <> text "->" <+> ppr w'
    | w > W64 || w' > W64  = pprPanic "Sign-extend Error: from/to register width greater than 64-bit." $ ppr w <> text "->" <+> ppr w'
    | w == W64 && w' == W64 && r == r' = nilOL
    | w == W32 && w' == W64 = unitOL $ SLL (OpReg W64 r') (OpReg w r) (OpImm (ImmInt 0))
    -- Sign-extend W8 and W16 to W64.
    | w `elem` [W8, W16] = unitOL $ EXT (OpReg W64 r') (OpReg w r)
    | w == w' = unitOL $ MOV (OpReg w' r') (OpReg w r)
    | otherwise = pprPanic "signExtend: Unexpected width: " $ ppr w  <> text "->" <+> ppr w'
  
  -- | Instructions to truncate the value in the given register from width @w@
  -- down to width @w'@.
  truncateReg :: Width -> Width -> Reg -> OrdList Instr
  truncateReg w w' r
    | w > W64 || w' > W64  = pprPanic "Tructate Error: from/to register width greater than 64-bit." $ ppr w <> text "->" <+> ppr w'
    | w == w' = nilOL
    | w /= w' = toOL
      [
        ann
          (text "truncateReg: " <+> ppr r <+> ppr w <> text "->" <> ppr w')
          (BSTRPICK II64 (OpReg w' r) (OpReg w r) (OpImm (ImmInt shift)) (OpImm (ImmInt 0)))
      ]
    | otherwise = pprPanic "truncateReg: Unexpected width: " $ ppr w  <> text "->" <+> ppr w'
    where
      shift = (min (widthInBits w) (widthInBits w')) - 1
  
  --  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     -- ^ width of loaded value
           -> CmmExpr
           -> NatM Amode
  
  -- LD/ST: Immediate can be represented with 12bits
  getAmode platform w (CmmRegOff reg off)
    | w <= W64, fitsInNbits 12 (fromIntegral off)
    = return $ Amode (AddrRegImm reg' off') nilOL
      where reg' = getRegisterReg platform reg
            off' = ImmInt 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 _ (CmmMachOp (MO_Add _w) [expr, CmmLit (CmmInt off _w')])
    | fitsInNbits 12 (fromIntegral off)
    = do (reg, _format, code) <- getSomeReg expr
         return $ Amode (AddrRegImm reg (ImmInteger off)) code
  
  getAmode _platform _ (CmmMachOp (MO_Sub _w) [expr, CmmLit (CmmInt off _w')])
    | fitsInNbits 12 (fromIntegral (-off))
    = do (reg, _format, code) <- getSomeReg expr
         return $ Amode (AddrRegImm reg (ImmInteger (-off))) code
  
  -- Generic case
  getAmode _platform _ expr
    = do (reg, _format, code) <- getSomeReg 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 rep addrE srcE
    = do
      (src_reg, _format, code) <- getSomeReg srcE
      platform <- getPlatform
      let w = formatToWidth 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`  ST rep (OpReg w src_reg) (OpAddr addr)
                       )
  
  assignReg_IntCode _ reg src
    = do
      platform <- getPlatform
      let dst = getRegisterReg platform reg
      r <- getRegister src
      return $ case r of
        Any _ code              -> COMMENT (text "CmmAssign" <+> parens (text (show reg)) <+> parens (text (show src))) `consOL` code dst
        Fixed format freg fcode -> COMMENT (text "CmmAssign" <+> parens (text (show reg)) <+> parens (text (show src))) `consOL`
                                                 (fcode `snocOL`
                                                   MOV (OpReg (formatToWidth format) dst) (OpReg (formatToWidth format) freg)
                                                 )
  
  -- Let's treat Floating point stuff
  -- as integer code for now. Opaque.
  assignMem_FltCode = assignMem_IntCode
  assignReg_FltCode = assignReg_IntCode
  
  -- Jumps
  genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock
  genJump expr = do
    case expr of
      (CmmLit (CmmLabel lbl)) -> do
        return $ unitOL (annExpr expr (TAIL36 (OpReg W64 tmpReg) (TLabel lbl)))
      (CmmLit (CmmBlock bid)) -> do
        return $ unitOL (annExpr expr (TAIL36 (OpReg W64 tmpReg) (TBlock bid)))
      _ -> do
        (target, _format, code) <- getSomeReg expr
        -- I'd like to do more.
        return $ COMMENT (text "genJump for unknow expr: " <+> (text (show expr))) `consOL`
          (code `appOL`
            unitOL (annExpr expr (J (TReg target)))
          )
  
  -- -----------------------------------------------------------------------------
  --  Unconditional branches
  genBranch :: BlockId -> NatM InstrBlock
  genBranch = return . toOL . mkJumpInstr
  
  -- -----------------------------------------------------------------------------
  -- Conditional branches
  genCondJump
      :: BlockId
      -> CmmExpr
      -> NatM InstrBlock
  genCondJump bid expr = do
      case expr of
        -- Optimized == 0 case.
        CmmMachOp (MO_Eq W64) [x, CmmLit (CmmInt 0 _)] -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          return $
            code_x `snocOL`
            BEQZ (OpReg W64 reg_x) (TBlock bid)
        CmmMachOp (MO_Eq w) [x, CmmLit (CmmInt 0 _)]
          | w `elem` [W8, W16, W32] -> do
          (reg_x, format_x, code_x) <- getSomeReg x
          return $
            code_x `appOL`
            signExtend (formatToWidth format_x) W64 reg_x reg_x `snocOL`
            BEQZ (OpReg W64 reg_x) (TBlock bid)
  
        -- Optimized /= 0 case.
        CmmMachOp (MO_Ne W64) [x, CmmLit (CmmInt 0 _)] -> do
          (reg_x, _format_x, code_x) <- getSomeReg x
          return $ code_x `snocOL` (annExpr expr (BNEZ (OpReg W64 reg_x) (TBlock bid)))
        CmmMachOp (MO_Ne w) [x, CmmLit (CmmInt 0 _)]
          | w `elem` [W8, W16, W32] -> do
          (reg_x, format_x, code_x) <- getSomeReg x
          return $
            code_x `appOL`
            signExtend (formatToWidth format_x) W64 reg_x reg_x `snocOL`
            BNEZ (OpReg W64 reg_x) (TBlock bid)
  
        -- Generic case.
        CmmMachOp mop [x, y] -> do
          let ubcond w cmp = do
                (reg_x, format_x, code_x) <- getSomeReg x
                (reg_y, format_y, code_y) <- getSomeReg y
                return $ case w of
                  w | w `elem` [W8, W16, W32] ->
                      code_x `appOL`
                      truncateReg (formatToWidth format_x) W64 reg_x  `appOL`
                      code_y `appOL`
                      truncateReg (formatToWidth format_y) W64 reg_y  `snocOL`
                      BCOND1 cmp (OpReg W64 reg_x) (OpReg W64 reg_y) (TBlock bid)
                  _ ->
                      code_x `appOL`
                      code_y `snocOL`
                      BCOND1 cmp (OpReg W64 reg_x) (OpReg W64 reg_y) (TBlock bid)
  
              sbcond w cmp = do
                (reg_x, format_x, code_x) <- getSomeReg x
                (reg_y, format_y, code_y) <- getSomeReg y
                return $ case w of
                  w | w `elem` [W8, W16, W32] ->
                    code_x `appOL`
                    signExtend (formatToWidth format_x) W64 reg_x reg_x `appOL`
                    code_y `appOL`
                    signExtend (formatToWidth format_y) W64 reg_y reg_y `snocOL`
                    BCOND1 cmp (OpReg W64 reg_x) (OpReg W64 reg_y) (TBlock bid)
                  _ ->
                    code_x `appOL`
                    code_y `snocOL`
                    BCOND1 cmp (OpReg W64 reg_x) (OpReg W64 reg_y) (TBlock bid)
  
              fbcond w cmp = do
                (reg_fx, _format_fx, code_fx) <- getFloatReg x
                (reg_fy, _format_fy, code_fy) <- getFloatReg y
                rst <- OpReg W64 <$> getNewRegNat II64
                oneReg <- OpReg W64 <$> getNewRegNat II64
                return $
                  code_fx `appOL`
                  code_fy `snocOL`
                  CSET cmp rst (OpReg w reg_fx) (OpReg w reg_fy) `snocOL`
                  MOV oneReg (OpImm (ImmInt 1)) `snocOL`
                  BCOND1 EQ rst oneReg (TBlock bid)
  
  
          case mop of
            MO_F_Eq w -> fbcond w EQ
            MO_F_Ne w -> fbcond w NE
            MO_F_Gt w -> fbcond w FGT
            MO_F_Ge w -> fbcond w FGE
            MO_F_Lt w -> fbcond w FLT
            MO_F_Le w -> fbcond w FLE
            MO_Eq w   -> sbcond w EQ
            MO_Ne w   -> sbcond w NE
            MO_S_Gt w -> sbcond w SGT
            MO_S_Ge w -> sbcond w SGE
            MO_S_Lt w -> sbcond w SLT
            MO_S_Le w -> sbcond w SLE
            MO_U_Gt w -> ubcond w UGT
            MO_U_Ge w -> ubcond w UGE
            MO_U_Lt w -> ubcond w ULT
            MO_U_Le w -> ubcond w ULE
            _ -> pprPanic "LA64.genCondJump:case mop: " (text $ show expr)
  
        _ -> pprPanic "LA64.genCondJump: " (text $ show expr)
  
  -- | Generate conditional branching instructions
  -- This is basically an "if with else" statement.
  genCondBranch ::
    BlockId ->
    BlockId ->
    CmmExpr ->
    NatM InstrBlock
  genCondBranch true false expr = do
    b1 <- genCondJump true expr
    b2 <- genBranch false
    return (b1 `appOL` b2)
  
  -- -----------------------------------------------------------------------------
  {-
  Generating C calls
  
  Generate a call to a C function:
  
  GARs: 8 general-purpose registers $a0 - $a7, where $a0 and $a1 are also used for
  integral values.
  FARs: 8 floating-point registers $fa0 - $fa7, where $fa0 and $fa1 are also used
  for returning values.
  
  An argument is passed using the stack only when no appropriate argument register
  is available.
  
  Subroutines should ensure that the initial values of the general-purpose registers
  $s0 - $s9 and floating-point registers $fs0 - $fs7 are preserved across the call.
  
  At the entry of a procedure call, the return address of the call site is stored
  in $ra. A branch jump to this address should be the last instruction executed in
  the called procedure.
  
  The on-stack part of the structure and scalar arguments are aligned to the greater
  of the type alignment and GRLEN bits, except when this alignment is larger than
   the 16-byte stack alignment. In this case, the part of the argument should be
  16-byte-aligned.
  
  In a procedure call, GARs / FARs are generally only used for passing non-floating
  -point / floating-point argument data, respectively. However, the floating-point
  member of a structure or union argument, or a vector/floating-point argument
  wider than FRLEN may be passed in a GAR.
  -}
  
  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 target dest_regs arg_regs = do
    case target of
      -- The target :: ForeignTarget call can either
      -- be a foreign procedure with an address expr
      -- and a calling convention.
      ForeignTarget expr _cconv -> do
        (call_target, call_target_code) <- case expr of
          -- if this is a label, let's just directly to it.
          (CmmLit (CmmLabel lbl)) -> pure (TLabel lbl, nilOL)
          -- if it's not a label, let's compute the expression into a
          -- register and jump to that.
          _ -> do
            (reg, _format, reg_code) <- getSomeReg expr
            pure (TReg reg, reg_code)
        -- compute the code and register logic for all arg_regs.
        -- this will give us the format information to match on.
        arg_regs' <- mapM getSomeReg arg_regs
  
        -- Now this is stupid.  Our Cmm expressions doesn't carry the proper sizes
        -- so while in Cmm we might get W64 incorrectly for an int, that is W32 in
        -- STG; this thenn breaks packing of stack arguments, if we need to pack
        -- for the pcs, e.g. darwinpcs.  Option one would be to fix the Int type
        -- in Cmm proper. Option two, which we choose here is to use extended Hint
        -- information to contain the size information and use that when packing
        -- arguments, spilled onto the stack.
        let (_res_hints, arg_hints) = foreignTargetHints target
            arg_regs'' = zipWith (\(r, f, c) h -> (r,f,h,c)) arg_regs' arg_hints
  
        (stackSpaceWords, passRegs, passArgumentsCode) <- passArguments allGpArgRegs allFpArgRegs arg_regs'' 0 [] nilOL
  
        readResultsCode <- readResults allGpArgRegs allFpArgRegs dest_regs [] nilOL
  
        let moveStackDown 0 = toOL [ PUSH_STACK_FRAME
                                   , DELTA (-16)
                                   ]
            moveStackDown i | odd i = moveStackDown (i + 1)
            moveStackDown i = toOL [ PUSH_STACK_FRAME
                                   , SUB (OpReg W64 (spMachReg)) (OpReg W64 (spMachReg)) (OpImm (ImmInt (8 * i)))
                                   , DELTA (-8 * i - 16)
                                   ]
            moveStackUp 0 = toOL [ POP_STACK_FRAME
                                 , DELTA 0
                                 ]
            moveStackUp i | odd i = moveStackUp (i + 1)
            moveStackUp i = toOL [ ADD (OpReg W64 (spMachReg)) (OpReg W64 (spMachReg)) (OpImm (ImmInt (8 * i)))
                                 , POP_STACK_FRAME
                                 , DELTA 0
                                 ]
  
        let code =
              call_target_code -- compute the label (possibly into a register)
                `appOL` moveStackDown (stackSpaceWords)
                `appOL` passArgumentsCode -- put the arguments into x0, ...
                `snocOL` CALL call_target passRegs -- branch and link (C calls aren't tail calls, but return)
                `appOL` readResultsCode -- parse the results into registers
                `appOL` moveStackUp (stackSpaceWords)
        return code
  
      PrimTarget MO_F32_Fabs
        | [arg_reg] <- arg_regs, [dest_reg] <- dest_regs ->
          unaryFloatOp W32 (\d x -> unitOL $ FABS d x) arg_reg dest_reg
        | otherwise -> panic "mal-formed MO_F32_Fabs"
      PrimTarget MO_F64_Fabs
        | [arg_reg] <- arg_regs, [dest_reg] <- dest_regs ->
          unaryFloatOp W64 (\d x -> unitOL $ FABS d x) arg_reg dest_reg
        | otherwise -> panic "mal-formed MO_F64_Fabs"
  
      PrimTarget MO_F32_Sqrt
        | [arg_reg] <- arg_regs, [dest_reg] <- dest_regs ->
          unaryFloatOp W32 (\d x -> unitOL $ FSQRT d x) arg_reg dest_reg
        | otherwise -> panic "mal-formed MO_F32_Sqrt"
      PrimTarget MO_F64_Sqrt
        | [arg_reg] <- arg_regs, [dest_reg] <- dest_regs ->
          unaryFloatOp W64 (\d x -> unitOL $ FSQRT d x) arg_reg dest_reg
        | otherwise -> panic "mal-formed MO_F64_Sqrt"
  
      PrimTarget (MO_Clz w)
        | w `elem` [W32, W64],
        [arg_reg] <- arg_regs,
        [dest_reg] <- dest_regs -> do
        platform <- getPlatform
        (reg_x, _format_x, code_x) <- getSomeReg arg_reg
        let dst_reg = getRegisterReg platform (CmmLocal dest_reg)
        return ( code_x `snocOL`
                 CLZ (OpReg w dst_reg) (OpReg w reg_x)
               )
        | w `elem` [W8, W16],
        [arg_reg] <- arg_regs,
        [dest_reg] <- dest_regs -> do
          platform <- getPlatform
          (reg_x, _format_x, code_x) <- getSomeReg arg_reg
          let dst_reg = getRegisterReg platform (CmmLocal dest_reg)
          return ( code_x `appOL` toOL
                   [
                    MOV (OpReg W64 dst_reg) (OpImm (ImmInt 1)),
                    SLL (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpImm (ImmInt (31-shift))),
                    SLL (OpReg W64 reg_x) (OpReg W64 reg_x) (OpImm (ImmInt (32-shift))),
                    OR (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpReg W64 reg_x),
                    CLZ (OpReg W64 dst_reg) (OpReg W32 dst_reg)
                   ]
                 )
        | otherwise -> unsupported (MO_Clz w)
        where
          shift = widthToInt w
  
      PrimTarget (MO_Ctz w)
        | w `elem` [W32, W64],
        [arg_reg] <- arg_regs,
        [dest_reg] <- dest_regs -> do
        platform <- getPlatform
        (reg_x, _format_x, code_x) <- getSomeReg arg_reg
        let dst_reg = getRegisterReg platform (CmmLocal dest_reg)
        return ( code_x `snocOL`
                 CTZ (OpReg w dst_reg) (OpReg w reg_x)
               )
        | w `elem` [W8, W16],
        [arg_reg] <- arg_regs,
        [dest_reg] <- dest_regs -> do
        platform <- getPlatform
        (reg_x, _format_x, code_x) <- getSomeReg arg_reg
        let dst_reg = getRegisterReg platform (CmmLocal dest_reg)
        return ( code_x `appOL` toOL
                 [
                  MOV (OpReg W64 dst_reg) (OpImm (ImmInt 1)),
                  SLL (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpImm (ImmInt shift)),
                  BSTRPICK II64 (OpReg W64 reg_x) (OpReg W64 reg_x) (OpImm (ImmInt (shift-1))) (OpImm (ImmInt 0)),
                  OR  (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpReg W64 reg_x),
                  CTZ (OpReg W64 dst_reg) (OpReg W64 dst_reg)
                 ]
               )
        | otherwise -> unsupported (MO_Ctz w)
        where
          shift = (widthToInt w)
  
      PrimTarget (MO_BSwap w)
        | w `elem` [W16, W32, W64],
        [arg_reg] <- arg_regs,
        [dest_reg] <- dest_regs -> do
        platform <- getPlatform
        (reg_x, _, code_x) <- getSomeReg arg_reg
        let dst_reg = getRegisterReg platform (CmmLocal dest_reg)
        case w of
          W64 -> return ( code_x `appOL` toOL
                        [
                          REVBD (OpReg w dst_reg) (OpReg w reg_x)
                        ])
          W32 -> return ( code_x `appOL` toOL
                        [
                          REVB2W (OpReg w dst_reg) (OpReg w reg_x)
                        ])
          _ -> return ( code_x `appOL` toOL
                        [
                          REVB2H (OpReg w dst_reg) (OpReg w reg_x)
                        ])
        | otherwise -> unsupported (MO_BSwap w)
  
      PrimTarget (MO_BRev w)
        | w `elem` [W8, W16, W32, W64],
        [arg_reg] <- arg_regs,
        [dest_reg] <- dest_regs -> do
        platform <- getPlatform
        (reg_x, _, code_x) <- getSomeReg arg_reg
        let dst_reg = getRegisterReg platform (CmmLocal dest_reg)
        case w of
          W8 -> return ( code_x `appOL` toOL
                       [
                         BITREV4B (OpReg W32 reg_x) (OpReg W32 reg_x),
                         AND (OpReg W64 dst_reg) (OpReg W64 reg_x) (OpImm (ImmInt 255))
                       ])
          W16 -> return ( code_x `appOL` toOL
                        [
                          BITREV (OpReg W64 reg_x) (OpReg W64 reg_x),
                          SRL (OpReg W64 dst_reg) (OpReg W64 reg_x) (OpImm (ImmInt 48))
                        ])
          _ -> return ( code_x `snocOL` BITREV (OpReg w dst_reg) (OpReg w reg_x))
        | otherwise -> unsupported (MO_BRev w)
  
      -- mop :: CallishMachOp (see GHC.Cmm.MachOp)
      PrimTarget mop -> do
        -- We'll need config to construct forien targets
        case mop of
          -- 64 bit float ops
          MO_F64_Pwr   -> mkCCall "pow"
  
          MO_F64_Sin   -> mkCCall "sin"
          MO_F64_Cos   -> mkCCall "cos"
          MO_F64_Tan   -> mkCCall "tan"
  
          MO_F64_Sinh  -> mkCCall "sinh"
          MO_F64_Cosh  -> mkCCall "cosh"
          MO_F64_Tanh  -> mkCCall "tanh"
  
          MO_F64_Asin  -> mkCCall "asin"
          MO_F64_Acos  -> mkCCall "acos"
          MO_F64_Atan  -> mkCCall "atan"
  
          MO_F64_Asinh -> mkCCall "asinh"
          MO_F64_Acosh -> mkCCall "acosh"
          MO_F64_Atanh -> mkCCall "atanh"
  
          MO_F64_Log   -> mkCCall "log"
          MO_F64_Log1P -> mkCCall "log1p"
          MO_F64_Exp   -> mkCCall "exp"
          MO_F64_ExpM1 -> mkCCall "expm1"
  
          -- 32 bit float ops
          MO_F32_Pwr   -> mkCCall "powf"
  
          MO_F32_Sin   -> mkCCall "sinf"
          MO_F32_Cos   -> mkCCall "cosf"
          MO_F32_Tan   -> mkCCall "tanf"
          MO_F32_Sinh  -> mkCCall "sinhf"
          MO_F32_Cosh  -> mkCCall "coshf"
          MO_F32_Tanh  -> mkCCall "tanhf"
          MO_F32_Asin  -> mkCCall "asinf"
          MO_F32_Acos  -> mkCCall "acosf"
          MO_F32_Atan  -> mkCCall "atanf"
          MO_F32_Asinh -> mkCCall "asinhf"
          MO_F32_Acosh -> mkCCall "acoshf"
          MO_F32_Atanh -> mkCCall "atanhf"
          MO_F32_Log   -> mkCCall "logf"
          MO_F32_Log1P -> mkCCall "log1pf"
          MO_F32_Exp   -> mkCCall "expf"
          MO_F32_ExpM1 -> mkCCall "expm1f"
  
          -- 64-bit primops
          MO_I64_ToI   -> mkCCall "hs_int64ToInt"
          MO_I64_FromI -> mkCCall "hs_intToInt64"
          MO_W64_ToW   -> mkCCall "hs_word64ToWord"
          MO_W64_FromW -> mkCCall "hs_wordToWord64"
          MO_x64_Neg   -> mkCCall "hs_neg64"
          MO_x64_Add   -> mkCCall "hs_add64"
          MO_x64_Sub   -> mkCCall "hs_sub64"
          MO_x64_Mul   -> mkCCall "hs_mul64"
          MO_I64_Quot  -> mkCCall "hs_quotInt64"
          MO_I64_Rem   -> mkCCall "hs_remInt64"
          MO_W64_Quot  -> mkCCall "hs_quotWord64"
          MO_W64_Rem   -> mkCCall "hs_remWord64"
          MO_x64_And   -> mkCCall "hs_and64"
          MO_x64_Or    -> mkCCall "hs_or64"
          MO_x64_Xor   -> mkCCall "hs_xor64"
          MO_x64_Not   -> mkCCall "hs_not64"
          MO_x64_Shl   -> mkCCall "hs_uncheckedShiftL64"
          MO_I64_Shr   -> mkCCall "hs_uncheckedIShiftRA64"
          MO_W64_Shr   -> mkCCall "hs_uncheckedShiftRL64"
          MO_x64_Eq    -> mkCCall "hs_eq64"
          MO_x64_Ne    -> mkCCall "hs_ne64"
          MO_I64_Ge    -> mkCCall "hs_geInt64"
          MO_I64_Gt    -> mkCCall "hs_gtInt64"
          MO_I64_Le    -> mkCCall "hs_leInt64"
          MO_I64_Lt    -> mkCCall "hs_ltInt64"
          MO_W64_Ge    -> mkCCall "hs_geWord64"
          MO_W64_Gt    -> mkCCall "hs_gtWord64"
          MO_W64_Le    -> mkCCall "hs_leWord64"
          MO_W64_Lt    -> mkCCall "hs_ltWord64"
  
          -- Conversion
          MO_UF_Conv w        -> mkCCall (word2FloatLabel w)
  
          -- Optional MachOps
          -- These are enabled/disabled by backend flags: GHC.StgToCmm.Config
          MO_S_Mul2     _w -> unsupported mop
          MO_S_QuotRem  _w -> unsupported mop
          MO_U_QuotRem  _w -> unsupported mop
          MO_U_QuotRem2 _w -> unsupported mop
          MO_Add2       _w -> unsupported mop
          MO_AddWordC   _w -> unsupported mop
          MO_SubWordC   _w -> unsupported mop
          MO_AddIntC    _w -> unsupported mop
          MO_SubIntC    _w -> unsupported mop
          MO_U_Mul2     _w -> unsupported mop
  
          MO_VS_Quot {} -> unsupported mop
          MO_VS_Rem {}  -> unsupported mop
          MO_VU_Quot {} -> unsupported mop
          MO_VU_Rem {}  -> unsupported mop
          MO_I64X2_Min -> unsupported mop
          MO_I64X2_Max -> unsupported mop
          MO_W64X2_Min -> unsupported mop
          MO_W64X2_Max -> unsupported mop
  
          -- Memory Ordering
          -- Support finer-grained DBAR hints for LA664 and newer uarchs.
          -- These are treated as DBAR 0 on older uarchs, so we can start
          -- to unconditionally emit the new hints right away.
          MO_AcquireFence -> pure (unitOL (DBAR HintAcquire))
          MO_ReleaseFence -> pure (unitOL (DBAR HintRelease))
          MO_SeqCstFence  -> pure (unitOL (DBAR HintSeqcst))
  
          MO_Touch        -> pure nilOL -- Keep variables live (when using interior pointers)
          -- Prefetch
          MO_Prefetch_Data _n -> pure nilOL -- Prefetch hint.
  
          -- Memory copy/set/move/cmp, with alignment for optimization
  
          -- TODO Optimize and use e.g. quad registers to move memory around instead
          -- of offloading this to memcpy. For small memcpys we can utilize
          -- the 128bit quad registers in NEON to move block of bytes around.
          -- Might also make sense of small memsets? Use xzr? What's the function
          -- call overhead?
          MO_Memcpy  _align   -> mkCCall "memcpy"
          MO_Memset  _align   -> mkCCall "memset"
          MO_Memmove _align   -> mkCCall "memmove"
          MO_Memcmp  _align   -> mkCCall "memcmp"
  
          MO_SuspendThread    -> mkCCall "suspendThread"
          MO_ResumeThread     -> mkCCall "resumeThread"
  
          MO_PopCnt w         -> mkCCall (popCntLabel w)
          MO_Pdep w           -> mkCCall (pdepLabel w)
          MO_Pext w           -> mkCCall (pextLabel w)
  
      -- or a possibly side-effecting machine operation
          mo@(MO_AtomicRead w ord)
            | [p_reg] <- arg_regs
            , [dst_reg] <- dest_regs -> do
                (p, _fmt_p, code_p) <- getSomeReg p_reg
                platform <- getPlatform
                let instrs = case ord of
                        MemOrderRelaxed -> unitOL $ ann moDescr (LD (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p))
  
                        MemOrderAcquire -> toOL [
                                                  ann moDescr (LD (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p)),
                                                  DBAR HintAcquire
                                                ]
                        MemOrderSeqCst -> toOL  [
                                                  ann moDescr (LD (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p)),
                                                  DBAR HintSeqcst
                                                ]
                        _ -> panic $ "Unexpected MemOrderRelease on an AtomicRead: " ++ show mo
                    dst = getRegisterReg platform (CmmLocal dst_reg)
                    moDescr = (text . show) mo
                    code = code_p `appOL` instrs
                pure code
            | otherwise -> panic "mal-formed AtomicRead"
  
          mo@(MO_AtomicWrite w ord)
            | [p_reg, val_reg] <- arg_regs -> do
                (p, _fmt_p, code_p) <- getSomeReg p_reg
                (val, fmt_val, code_val) <- getSomeReg val_reg
                let instrs = case ord of
                        MemOrderRelaxed -> unitOL $ ann moDescr (ST fmt_val (OpReg w val) (OpAddr $ AddrReg p))
                        -- AMSWAP_DB* insns implentment a fully functional synchronization barrier, like DBAR 0x0.
                        -- This is terrible. And AMSWAPDB only supports ISA version greater than LA64V1_0. So,
                        -- implement with DBAR
                        MemOrderRelease -> toOL [
                                                  ann moDescr (DBAR HintRelease),
                                                  ST fmt_val (OpReg w val) (OpAddr $ AddrReg p)
                                                ]
                        MemOrderSeqCst  -> toOL [
                                                  ann moDescr (DBAR HintSeqcst),
                                                  ST fmt_val (OpReg w val) (OpAddr $ AddrReg p)
                                                ]
                        _ ->  panic $ "Unexpected MemOrderAcquire on an AtomicWrite" ++ show mo
                    moDescr = (text . show) mo
                    code =
                      code_p `appOL`
                      code_val `appOL`
                      instrs
                pure code
            | otherwise -> panic "mal-formed AtomicWrite"
  
          MO_AtomicRMW w amop -> mkCCall (atomicRMWLabel w amop)
          MO_Cmpxchg w        -> mkCCall (cmpxchgLabel w)
          MO_Xchg w           -> mkCCall (xchgLabel w)
  
    where
      unsupported :: Show a => a -> b
      unsupported mop = panic ("outOfLineCmmOp: " ++ show mop
                            ++ " not supported here")
  
      mkCCall :: FastString -> NatM InstrBlock
      mkCCall name = do
        config <- getConfig
        target <-
          cmmMakeDynamicReference config CallReference
            $ mkForeignLabel name ForeignLabelInThisPackage IsFunction
        let cconv = ForeignConvention CCallConv [NoHint] [NoHint] CmmMayReturn
        genCCall (ForeignTarget target cconv) dest_regs arg_regs
  
      -- Implementiation of the LoongArch ABI calling convention.
      -- https://github.com/loongson/la-abi-specs/blob/release/lapcs.adoc#passing-arguments
      passArguments :: [Reg] -> [Reg] -> [(Reg, Format, ForeignHint, InstrBlock)] -> Int -> [Reg] -> InstrBlock -> NatM (Int, [Reg], InstrBlock)
  
      -- 1. Base case: no more arguments to pass (left)
      passArguments _ _ [] stackSpaceWords accumRegs accumCode = return (stackSpaceWords, accumRegs, accumCode)
  
      -- 2. Still have GP regs, and we want to pass an GP argument.
      passArguments (gpReg : gpRegs) fpRegs ((r, format, _hint, code_r) : args) stackSpaceWords accumRegs accumCode | isIntFormat format = do
        let w = formatToWidth format
            ext
              -- Specifically, LoongArch64's ABI requires that the caller
              -- sign-extend arguments which are smaller than 64-bits.
              | w `elem` [W8, W16, W32]
              = case w of
                W8  -> EXT (OpReg W64 gpReg) (OpReg w r)
                W16 -> EXT (OpReg W64 gpReg) (OpReg w r)
                W32 -> SLL (OpReg W64 gpReg) (OpReg w r) (OpImm (ImmInt 0))
                _ -> panic "Unexpected width(Here w < W64)!"
              | otherwise
              = MOV (OpReg w gpReg) (OpReg w r)
            accumCode' = accumCode `appOL`
                            code_r `snocOL`
                            ann (text "Pass gp argument: " <> ppr r) ext
  
        passArguments gpRegs fpRegs args stackSpaceWords (gpReg : accumRegs) accumCode'
  
      -- 3. Still have FP regs, and we want to pass an FP argument.
      passArguments gpRegs (fpReg : fpRegs) ((r, format, _hint, code_r) : args) stackSpaceWords accumRegs accumCode | isFloatFormat format = do
        let w = formatToWidth format
            mov = MOV (OpReg w fpReg) (OpReg w r)
            accumCode' = accumCode `appOL`
                         code_r `snocOL`
                         ann (text "Pass fp argument: " <> ppr r) mov
  
        passArguments gpRegs fpRegs args stackSpaceWords (fpReg : accumRegs) accumCode'
  
      -- 4. No mor regs left to pass. Must pass on stack.
      passArguments [] [] ((r, format, _hint, code_r) : args) stackSpaceWords accumRegs accumCode = do
        let w = formatToWidth format
            spOffet = 8 * stackSpaceWords
            str = ST format (OpReg w r) (OpAddr (AddrRegImm spMachReg (ImmInt spOffet)))
            stackCode =
              code_r
                `snocOL` (MOV (OpReg w tmpReg) (OpReg w r))
                `appOL` truncateReg w W64 tmpReg
                `snocOL` ann (text "Pass signed argument (size " <> ppr w <> text ") on the stack: " <> ppr tmpReg) str
  
        passArguments [] [] args (stackSpaceWords + 1) accumRegs (stackCode `appOL` accumCode)
  
      -- 5. Still have fpRegs left, but want to pass a GP argument. Must be passed on the stack then.
      passArguments [] fpRegs ((r, format, _hint, code_r) : args) stackSpaceWords accumRegs accumCode | isIntFormat format = do
        let w = formatToWidth format
            spOffet = 8 * stackSpaceWords
            str = ST format (OpReg w r) (OpAddr (AddrRegImm spMachReg (ImmInt spOffet)))
            stackCode =
              code_r
                `snocOL` ann (text "Pass argument (size " <> ppr w <> text ") on the stack: " <> ppr r) str
  
        passArguments [] fpRegs args (stackSpaceWords + 1) accumRegs (stackCode `appOL` accumCode)
  
     -- 6. Still have gpRegs left, but want to pass a FP argument. Must be passed in gpReg then.
      passArguments (gpReg : gpRegs) [] ((r, format, _hint, code_r) : args) stackSpaceWords accumRegs accumCode | isFloatFormat format = do
        let w = formatToWidth format
            mov = MOV (OpReg w gpReg) (OpReg w r)
            accumCode' = accumCode `appOL`
                         code_r `snocOL`
                         ann (text "Pass fp argument in gpReg: " <> ppr r) mov
  
        passArguments gpRegs [] args stackSpaceWords (gpReg : accumRegs) accumCode'
  
  
      passArguments _ _ _ _ _ _ = pprPanic "passArguments" (text "invalid state")
  
      readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg] -> InstrBlock -> NatM InstrBlock
      readResults _ _ [] _ accumCode = return accumCode
      readResults [] _ _ _ _ = do
        platform <- getPlatform
        pprPanic "genCCall, out of gp registers when reading results" (pdoc platform target)
      readResults _ [] _ _ _ = do
        platform <- getPlatform
        pprPanic "genCCall, out of fp registers when reading results" (pdoc platform target)
      readResults (gpReg:gpRegs) (fpReg:fpRegs) (dst:dsts) accumRegs accumCode = do
        -- gp/fp reg -> dst
        platform <- getPlatform
        let rep = cmmRegType (CmmLocal dst)
            format = cmmTypeFormat rep
            w = cmmRegWidth (CmmLocal dst)
            r_dst = getRegisterReg platform (CmmLocal 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
  
      unaryFloatOp w op arg_reg dest_reg = do
        platform <- getPlatform
        (reg_fx, _format_x, code_fx) <- getFloatReg arg_reg
        let dst = getRegisterReg platform (CmmLocal dest_reg)
        let code = code_fx `appOL` op (OpReg w dst) (OpReg w reg_fx)
        pure code
  
  data BlockInRange = InRange | NotInRange BlockId
  
  genCondFarJump :: (MonadGetUnique m) => Cond -> Operand -> Operand -> BlockId -> m InstrBlock
  genCondFarJump cond op1 op2 far_target = do
    return $ toOL [ ann (text "Conditional far jump to: " <> ppr far_target)
                  $ BCOND cond op1 op2 (TBlock far_target)
                  ]
  
  makeFarBranches ::
    Platform ->
    LabelMap RawCmmStatics ->
    [NatBasicBlock Instr] ->
    UniqDSM [NatBasicBlock Instr]
  
  makeFarBranches {- only used when debugging -} _platform statics basic_blocks = do
    -- All offsets/positions are counted in multiples of 4 bytes (the size of LoongArch64 instructions)
    -- That is an offset of 1 represents a 4-byte/one instruction offset.
    let (func_size, lblMap) = foldl' calc_lbl_positions (0, mapEmpty) basic_blocks
    if func_size < max_cond_jump_dist
      then pure basic_blocks
      else do
        (_, blocks) <- mapAccumLM (replace_blk lblMap) 0 basic_blocks
        pure $ concat blocks
    where
      max_cond_jump_dist = 2 ^ (15 :: Int) - 8 :: Int
      -- Currently all inline info tables fit into 64 bytes.
      max_info_size = 16 :: Int
      long_bc_jump_dist = 2 :: Int
  
      -- Replace out of range conditional jumps with unconditional jumps.
      replace_blk :: LabelMap Int -> Int -> GenBasicBlock Instr -> UniqDSM (Int, [GenBasicBlock Instr])
      replace_blk !m !pos (BasicBlock lbl instrs) = do
        -- Account for a potential info table before the label.
        let !block_pos = pos + infoTblSize_maybe lbl
        (!pos', instrs') <- mapAccumLM (replace_jump m) block_pos instrs
        let instrs'' = concat 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 = BasicBlock lbl top : split_blocks
        pure (pos', final_blocks)
  
      replace_jump :: LabelMap Int -> Int -> Instr -> UniqDSM (Int, [Instr])
      replace_jump !m !pos instr = do
        case instr of
          ANN ann instr -> do
            replace_jump m pos instr >>= \case
              (idx, instr' : instrs') -> pure (idx, ANN ann instr' : instrs')
              (idx, []) -> pprPanic "replace_jump" (text "empty return list for " <+> ppr idx)
  
          BCOND1 cond op1 op2 t ->
            case target_in_range m t pos of
              InRange -> pure (pos + 1, [instr])
              NotInRange far_target -> do
                jmp_code <- genCondFarJump cond op1 op2 far_target
                pure (pos + long_bc_jump_dist, fromOL jmp_code)
  
          _ -> pure (pos + instr_size instr, [instr])
  
      target_in_range :: LabelMap Int -> Target -> Int -> BlockInRange
      target_in_range m target src =
        case target of
          (TReg{}) -> InRange
          (TBlock bid) -> block_in_range m src bid
          (TLabel clbl)
            | Just bid <- maybeLocalBlockLabel clbl
            -> block_in_range m src bid
            | otherwise
            -> InRange
  
      block_in_range :: LabelMap Int -> Int -> BlockId -> BlockInRange
      block_in_range m src_pos dest_lbl =
        case mapLookup dest_lbl m of
          Nothing ->
            pprTrace "not in range" (ppr dest_lbl) $ NotInRange dest_lbl
          Just dest_pos ->
            if abs (dest_pos - src_pos) < max_cond_jump_dist
              then InRange
            else NotInRange dest_lbl
  
      calc_lbl_positions :: (Int, LabelMap Int) -> GenBasicBlock Instr -> (Int, LabelMap Int)
      calc_lbl_positions (pos, m) (BasicBlock lbl instrs) =
        let !pos' = pos + infoTblSize_maybe lbl
         in foldl' instr_pos (pos', mapInsert lbl pos' m) instrs
  
      instr_pos :: (Int, LabelMap Int) -> Instr -> (Int, LabelMap Int)
      instr_pos (pos, m) instr = (pos + instr_size instr, m)
  
      infoTblSize_maybe bid =
        case mapLookup bid statics of
          Nothing -> 0 :: Int
          Just _info_static -> max_info_size
  
      instr_size :: Instr -> Int
      instr_size i = case i of
        COMMENT {} -> 0
        MULTILINE_COMMENT {} -> 0
        ANN _ instr -> instr_size instr
        LOCATION {} -> 0
        DELTA {} -> 0
        -- At this point there should be no NEWBLOCK in the instruction stream (pos, mapInsert bid pos m)
        NEWBLOCK {} -> panic "mkFarBranched - Unexpected"
        LDATA {} -> panic "mkFarBranched - Unexpected"
        PUSH_STACK_FRAME -> 4
        POP_STACK_FRAME -> 4
        CSET {} -> 2
        LD _ _ (OpImm (ImmIndex _ _)) -> 3
        LD _ _ (OpImm (ImmCLbl _)) -> 2
        SCVTF {} -> 2
        FCVTZS {} -> 4
        BCOND {} -> long_bc_jump_dist
        CALL (TReg _) _ -> 1
        CALL {} -> 2
        CALL36 {} -> 2
        TAIL36 {} -> 2
        _ -> 1
  