    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE NondecreasingIndentation #-}
    {-# LANGUAGE TupleSections #-}

    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

    -----------------------------------------------------------------------------
    --
    -- Generating machine code (instruction selection)
    --
    -- (c) The University of Glasgow 1996-2004
    --
    -----------------------------------------------------------------------------

    -- This is a big module, but, if you pay attention to
    -- (a) the sectioning, and (b) the type signatures, the
    -- structure should not be too overwhelming.

    module GHC.CmmToAsm.X86.CodeGen (
            cmmTopCodeGen,
            generateJumpTableForInstr,
            extractUnwindPoints,
            invertCondBranches,
            InstrBlock
    )

    where

    -- NCG stuff:
    import GHC.Prelude

    import GHC.CmmToAsm.X86.Instr
    import GHC.CmmToAsm.X86.Cond
    import GHC.CmmToAsm.X86.Regs
    import GHC.CmmToAsm.X86.Ppr
    import GHC.CmmToAsm.X86.RegInfo

    import GHC.Platform.Regs
    import GHC.CmmToAsm.CPrim
    import GHC.CmmToAsm.Types
    import GHC.Cmm.DebugBlock
       ( DebugBlock(..), UnwindPoint(..), UnwindTable
       , UnwindExpr(UwReg), toUnwindExpr
       )
    import GHC.CmmToAsm.PIC
    import GHC.CmmToAsm.Monad
       ( NatM, getNewRegNat, getNewLabelNat, setDeltaNat
       , getDeltaNat, getBlockIdNat, getPicBaseNat
       , Reg64(..), RegCode64(..), getNewReg64, localReg64
       , getPicBaseMaybeNat, getDebugBlock, getFileId
       , addImmediateSuccessorNat, updateCfgNat, getConfig, getPlatform
       , getCfgWeights
       )
    import GHC.CmmToAsm.CFG
    import GHC.CmmToAsm.Format
    import GHC.CmmToAsm.Config
    import GHC.Platform.Reg
    import GHC.Platform

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

    -- The rest:
    import GHC.Types.ForeignCall ( CCallConv(..) )
    import GHC.Data.OrdList
    import GHC.Utils.Outputable
    import GHC.Utils.Constants (debugIsOn)
    import GHC.Utils.Panic
    import GHC.Utils.Panic.Plain
    import GHC.Data.FastString
    import GHC.Utils.Misc
    import GHC.Types.Unique.Supply ( getUniqueM )

    import Control.Monad
    import Data.Foldable (fold)
    import Data.Int
    import Data.Maybe
    import Data.Word

    import qualified Data.Map as M

    is32BitPlatform :: NatM Bool
    is32BitPlatform :: NatM Bool
    is32BitPlatform = do
        Platform
    platform <- NatM Platform
    getPlatform
        Bool -> NatM Bool
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> NatM Bool) -> Bool -> NatM Bool
    forall a b. (a -> b) -> a -> b
    $ Platform -> Bool
    target32Bit Platform
    platform

    expect32BitPlatform :: SDoc -> NatM ()
    expect32BitPlatform :: SDoc -> NatM ()
    expect32BitPlatform SDoc
    doc = do
      Bool
    is32Bit <- NatM Bool
    is32BitPlatform
      Bool -> NatM () -> NatM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not Bool
    is32Bit) (NatM () -> NatM ()) -> NatM () -> NatM ()
    forall a b. (a -> b) -> a -> b
    $
        String -> SDoc -> NatM ()
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "Expecting 32-bit platform" SDoc
    doc

    sse2Enabled :: NatM Bool
    sse2Enabled :: NatM Bool
    sse2Enabled = do
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      Bool -> NatM Bool
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (NCGConfig -> Maybe SseVersion
    ncgSseVersion NCGConfig
    config Maybe SseVersion -> Maybe SseVersion -> Bool
    forall a. Ord a => a -> a -> Bool
    >= SseVersion -> Maybe SseVersion
    forall a. a -> Maybe a
    Just SseVersion
    SSE2)

    sse4_2Enabled :: NatM Bool
    sse4_2Enabled :: NatM Bool
    sse4_2Enabled = do
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      Bool -> NatM Bool
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (NCGConfig -> Maybe SseVersion
    ncgSseVersion NCGConfig
    config Maybe SseVersion -> Maybe SseVersion -> Bool
    forall a. Ord a => a -> a -> Bool
    >= SseVersion -> Maybe SseVersion
    forall a. a -> Maybe a
    Just SseVersion
    SSE42)

    cmmTopCodeGen
            :: RawCmmDecl
            -> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]

    cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
    cmmTopCodeGen (CmmProc LabelMap RawCmmStatics
    info CLabel
    lab [GlobalReg]
    live CmmGraph
    graph) = do
      let blocks :: [CmmBlock]
    blocks = CmmGraph -> [CmmBlock]
    toBlockListEntryFirst CmmGraph
    graph
      ([[NatBasicBlock Instr]]
    nat_blocks,[[NatCmmDecl (Alignment, RawCmmStatics) Instr]]
    statics) <- (CmmBlock
     -> NatM
          ([NatBasicBlock Instr],
           [NatCmmDecl (Alignment, RawCmmStatics) Instr]))
    -> [CmmBlock]
    -> NatM
         ([[NatBasicBlock Instr]],
          [[NatCmmDecl (Alignment, RawCmmStatics) Instr]])
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> m (b, c)) -> [a] -> m ([b], [c])
    mapAndUnzipM CmmBlock
    -> NatM
         ([NatBasicBlock Instr],
          [NatCmmDecl (Alignment, RawCmmStatics) Instr])
    basicBlockCodeGen [CmmBlock]
    blocks
      Maybe Reg
    picBaseMb <- NatM (Maybe Reg)
    getPicBaseMaybeNat
      Platform
    platform <- NatM Platform
    getPlatform
      let proc :: NatCmmDecl (Alignment, RawCmmStatics) Instr
    proc = LabelMap RawCmmStatics
    -> CLabel
    -> [GlobalReg]
    -> ListGraph Instr
    -> NatCmmDecl (Alignment, RawCmmStatics) Instr
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc LabelMap RawCmmStatics
    info CLabel
    lab [GlobalReg]
    live ([NatBasicBlock Instr] -> ListGraph Instr
    forall i. [GenBasicBlock i] -> ListGraph i
    ListGraph ([NatBasicBlock Instr] -> ListGraph Instr)
    -> [NatBasicBlock Instr] -> ListGraph Instr
    forall a b. (a -> b) -> a -> b
    $ [[NatBasicBlock Instr]] -> [NatBasicBlock Instr]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[NatBasicBlock Instr]]
    nat_blocks)
          tops :: [NatCmmDecl (Alignment, RawCmmStatics) Instr]
    tops = NatCmmDecl (Alignment, RawCmmStatics) Instr
    proc NatCmmDecl (Alignment, RawCmmStatics) Instr
    -> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
    -> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
    forall a. a -> [a] -> [a]
    : [[NatCmmDecl (Alignment, RawCmmStatics) Instr]]
    -> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[NatCmmDecl (Alignment, RawCmmStatics) Instr]]
    statics
          os :: OS
    os   = Platform -> OS
    platformOS Platform
    platform

      case Maybe Reg
    picBaseMb of
          Just Reg
    picBase -> Arch
    -> OS
    -> Reg
    -> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
    -> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
    initializePicBase_x86 Arch
    ArchX86 OS
    os Reg
    picBase [NatCmmDecl (Alignment, RawCmmStatics) Instr]
    tops
          Maybe Reg
    Nothing -> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
    -> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [NatCmmDecl (Alignment, RawCmmStatics) Instr]
    tops

    cmmTopCodeGen (CmmData Section
    sec RawCmmStatics
    dat) =
      [NatCmmDecl (Alignment, RawCmmStatics) Instr]
    -> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Section
    -> (Alignment, RawCmmStatics)
    -> NatCmmDecl (Alignment, RawCmmStatics) Instr
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData Section
    sec (Int -> Alignment
    mkAlignment Int
    1, RawCmmStatics
    dat)]  -- no translation, we just use CmmStatic

    {- Note [Verifying basic blocks]
       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       We want to guarantee a few things about the results
       of instruction selection.

       Namely that each basic blocks consists of:
        * A (potentially empty) sequence of straight line instructions
      followed by
        * A (potentially empty) sequence of jump like instructions.

        We can verify this by going through the instructions and
        making sure that any non-jumpish instruction can't appear
        after a jumpish instruction.

        There are gotchas however:
        * CALLs are strictly speaking control flow but here we care
          not about them. Hence we treat them as regular instructions.

          It's safe for them to appear inside a basic block
          as (ignoring side effects inside the call) they will result in
          straight line code.

        * NEWBLOCK marks the start of a new basic block so can
          be followed by any instructions.
    -}

    -- Verifying basic blocks is cheap, but not cheap enough to enable it unconditionally.
    verifyBasicBlock :: Platform -> [Instr] -> ()
    verifyBasicBlock :: Platform -> [Instr] -> ()
    verifyBasicBlock Platform
    platform [Instr]
    instrs
      | Bool
    debugIsOn     = Bool -> [Instr] -> ()
    go Bool
    False [Instr]
    instrs
      | Bool
    otherwise     = ()
      where
        go :: Bool -> [Instr] -> ()
    go Bool
    _     [] = ()
        go Bool
    atEnd (Instr
    i:[Instr]
    instr)
            = case Instr
    i of
                -- Start a new basic block
                NEWBLOCK {} -> Bool -> [Instr] -> ()
    go Bool
    False [Instr]
    instr
                -- Calls are not viable block terminators
                CALL {}     | Bool
    atEnd -> Instr -> ()
    faultyBlockWith Instr
    i
                            | Bool -> Bool
    not Bool
    atEnd -> Bool -> [Instr] -> ()
    go Bool
    atEnd [Instr]
    instr
                -- All instructions ok, check if we reached the end and continue.
                Instr
    _ | Bool -> Bool
    not Bool
    atEnd -> Bool -> [Instr] -> ()
    go (Instr -> Bool
    isJumpishInstr Instr
    i) [Instr]
    instr
                  -- Only jumps allowed at the end of basic blocks.
                  | Bool
    otherwise -> if Instr -> Bool
    isJumpishInstr Instr
    i
                                    then Bool -> [Instr] -> ()
    go Bool
    True [Instr]
    instr
                                    else Instr -> ()
    faultyBlockWith Instr
    i
        faultyBlockWith :: Instr -> ()
    faultyBlockWith Instr
    i
            = String -> SDoc -> ()
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "Non control flow instructions after end of basic block."
                       (Platform -> Instr -> SDoc
    pprInstr Platform
    platform Instr
    i SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "in:" SDoc -> SDoc -> SDoc
    $$ [SDoc] -> SDoc
    vcat ((Instr -> SDoc) -> [Instr] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> Instr -> SDoc
    pprInstr Platform
    platform) [Instr]
    instrs))

    basicBlockCodeGen
            :: CmmBlock
            -> NatM ( [NatBasicBlock Instr]
                    , [NatCmmDecl (Alignment, RawCmmStatics) Instr])

    basicBlockCodeGen :: CmmBlock
    -> NatM
         ([NatBasicBlock Instr],
          [NatCmmDecl (Alignment, RawCmmStatics) Instr])
    basicBlockCodeGen CmmBlock
    block = do
      let (CmmNode C O
    _, Block CmmNode O O
    nodes, CmmNode O C
    tail)  = CmmBlock -> (CmmNode C O, Block CmmNode O O, CmmNode O C)
    forall (n :: Extensibility -> Extensibility -> *).
    Block n C C -> (n C O, Block n O O, n O C)
    blockSplit CmmBlock
    block
          id :: Label
    id = CmmBlock -> Label
    forall (x :: Extensibility). Block CmmNode C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel CmmBlock
    block
          stmts :: [CmmNode O O]
    stmts = Block CmmNode O O -> [CmmNode O O]
    forall (n :: Extensibility -> Extensibility -> *).
    Block n O O -> [n O O]
    blockToList Block CmmNode O O
    nodes
      -- Generate location directive
      Maybe DebugBlock
    dbg <- Label -> NatM (Maybe DebugBlock)
    getDebugBlock (CmmBlock -> Label
    forall (x :: Extensibility). Block CmmNode C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel CmmBlock
    block)
      OrdList Instr
    loc_instrs <- case DebugBlock -> Maybe CmmTickish
    dblSourceTick (DebugBlock -> Maybe CmmTickish)
    -> Maybe DebugBlock -> Maybe CmmTickish
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Maybe DebugBlock
    dbg of
        Just (SourceNote RealSrcSpan
    span String
    name)
          -> do Int
    fileId <- FastString -> NatM Int
    getFileId (RealSrcSpan -> FastString
    srcSpanFile RealSrcSpan
    span)
                let line :: Int
    line = RealSrcSpan -> Int
    srcSpanStartLine RealSrcSpan
    span; col :: Int
    col = RealSrcSpan -> Int
    srcSpanStartCol RealSrcSpan
    span
                OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int -> String -> Instr
    LOCATION Int
    fileId Int
    line Int
    col String
    name
        Maybe CmmTickish
    _ -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    forall a. OrdList a
    nilOL
      (OrdList Instr
    mid_instrs,Label
    mid_bid) <- Label -> [CmmNode O O] -> NatM (OrdList Instr, Label)
    stmtsToInstrs Label
    id [CmmNode O O]
    stmts
      (!OrdList Instr
    tail_instrs,Maybe Label
    _) <- Label -> CmmNode O C -> NatM (OrdList Instr, Maybe Label)
    forall (e :: Extensibility) (x :: Extensibility).
    Label -> CmmNode e x -> NatM (OrdList Instr, Maybe Label)
    stmtToInstrs Label
    mid_bid CmmNode O C
    tail
      let instrs :: OrdList Instr
    instrs = OrdList Instr
    loc_instrs OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    mid_instrs OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    tail_instrs
      Platform
    platform <- NatM Platform
    getPlatform
      () -> NatM ()
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (() -> NatM ()) -> () -> NatM ()
    forall a b. (a -> b) -> a -> b
    $! Platform -> [Instr] -> ()
    verifyBasicBlock Platform
    platform (OrdList Instr -> [Instr]
    forall a. OrdList a -> [a]
    fromOL OrdList Instr
    instrs)
      OrdList Instr
    instrs' <- OrdList (OrdList Instr) -> OrdList Instr
    forall m. Monoid m => OrdList m -> m
    forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
    fold (OrdList (OrdList Instr) -> OrdList Instr)
    -> NatM (OrdList (OrdList Instr)) -> NatM (OrdList Instr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList (OrdList Instr))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> OrdList a -> f (OrdList b)
    traverse Instr -> NatM (OrdList Instr)
    addSpUnwindings OrdList Instr
    instrs
      -- code generation may introduce new basic block boundaries, which
      -- are indicated by the NEWBLOCK instruction.  We must split up the
      -- instruction stream into basic blocks again.  Also, we extract
      -- LDATAs here too.
      let
            ([Instr]
    top,[NatBasicBlock Instr]
    other_blocks,[NatCmmDecl (Alignment, RawCmmStatics) Instr]
    statics) = (Instr
     -> ([Instr], [NatBasicBlock Instr],
         [NatCmmDecl (Alignment, RawCmmStatics) Instr])
     -> ([Instr], [NatBasicBlock Instr],
         [NatCmmDecl (Alignment, RawCmmStatics) Instr]))
    -> ([Instr], [NatBasicBlock Instr],
        [NatCmmDecl (Alignment, RawCmmStatics) Instr])
    -> OrdList Instr
    -> ([Instr], [NatBasicBlock Instr],
        [NatCmmDecl (Alignment, RawCmmStatics) Instr])
    forall a b. (a -> b -> b) -> b -> OrdList a -> b
    foldrOL Instr
    -> ([Instr], [NatBasicBlock Instr],
        [NatCmmDecl (Alignment, RawCmmStatics) Instr])
    -> ([Instr], [NatBasicBlock Instr],
        [NatCmmDecl (Alignment, RawCmmStatics) Instr])
    forall {h} {g}.
    Instr
    -> ([Instr], [NatBasicBlock Instr],
        [GenCmmDecl (Alignment, RawCmmStatics) h g])
    -> ([Instr], [NatBasicBlock Instr],
        [GenCmmDecl (Alignment, RawCmmStatics) h g])
    mkBlocks ([],[],[]) OrdList Instr
    instrs'

            mkBlocks :: Instr
    -> ([Instr], [NatBasicBlock Instr],
        [GenCmmDecl (Alignment, RawCmmStatics) h g])
    -> ([Instr], [NatBasicBlock Instr],
        [GenCmmDecl (Alignment, RawCmmStatics) h g])
    mkBlocks (NEWBLOCK Label
    id) ([Instr]
    instrs,[NatBasicBlock Instr]
    blocks,[GenCmmDecl (Alignment, RawCmmStatics) h g]
    statics)
              = ([], Label -> [Instr] -> NatBasicBlock Instr
    forall i. Label -> [i] -> GenBasicBlock i
    BasicBlock Label
    id [Instr]
    instrs NatBasicBlock Instr
    -> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
    forall a. a -> [a] -> [a]
    : [NatBasicBlock Instr]
    blocks, [GenCmmDecl (Alignment, RawCmmStatics) h g]
    statics)
            mkBlocks (LDATA Section
    sec (Alignment, RawCmmStatics)
    dat) ([Instr]
    instrs,[NatBasicBlock Instr]
    blocks,[GenCmmDecl (Alignment, RawCmmStatics) h g]
    statics)
              = ([Instr]
    instrs, [NatBasicBlock Instr]
    blocks, Section
    -> (Alignment, RawCmmStatics)
    -> GenCmmDecl (Alignment, RawCmmStatics) h g
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData Section
    sec (Alignment, RawCmmStatics)
    datGenCmmDecl (Alignment, RawCmmStatics) h g
    -> [GenCmmDecl (Alignment, RawCmmStatics) h g]
    -> [GenCmmDecl (Alignment, RawCmmStatics) h g]
    forall a. a -> [a] -> [a]
    :[GenCmmDecl (Alignment, RawCmmStatics) h g]
    statics)
            mkBlocks Instr
    instr ([Instr]
    instrs,[NatBasicBlock Instr]
    blocks,[GenCmmDecl (Alignment, RawCmmStatics) h g]
    statics)
              = (Instr
    instrInstr -> [Instr] -> [Instr]
    forall a. a -> [a] -> [a]
    :[Instr]
    instrs, [NatBasicBlock Instr]
    blocks, [GenCmmDecl (Alignment, RawCmmStatics) h g]
    statics)
      ([NatBasicBlock Instr],
     [NatCmmDecl (Alignment, RawCmmStatics) Instr])
    -> NatM
         ([NatBasicBlock Instr],
          [NatCmmDecl (Alignment, RawCmmStatics) Instr])
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Label -> [Instr] -> NatBasicBlock Instr
    forall i. Label -> [i] -> GenBasicBlock i
    BasicBlock Label
    id [Instr]
    top NatBasicBlock Instr
    -> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
    forall a. a -> [a] -> [a]
    : [NatBasicBlock Instr]
    other_blocks, [NatCmmDecl (Alignment, RawCmmStatics) Instr]
    statics)

    -- | Convert 'DELTA' instructions into 'UNWIND' instructions to capture changes
    -- in the @sp@ register. See Note [What is this unwinding business?] in "GHC.Cmm.DebugBlock"
    -- for details.
    addSpUnwindings :: Instr -> NatM (OrdList Instr)
    addSpUnwindings :: Instr -> NatM (OrdList Instr)
    addSpUnwindings instr :: Instr
    instr@(DELTA Int
    d) = do
        NCGConfig
    config <- NatM NCGConfig
    getConfig
        if NCGConfig -> Bool
    ncgDwarfUnwindings NCGConfig
    config
            then do CLabel
    lbl <- Unique -> CLabel
    forall a. Uniquable a => a -> CLabel
    mkAsmTempLabel (Unique -> CLabel) -> NatM Unique -> NatM CLabel
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NatM Unique
    forall (m :: * -> *). MonadUnique m => m Unique
    getUniqueM
                    let unwind :: Map GlobalReg (Maybe UnwindExpr)
    unwind = GlobalReg -> Maybe UnwindExpr -> Map GlobalReg (Maybe UnwindExpr)
    forall k a. k -> a -> Map k a
    M.singleton GlobalReg
    MachSp (UnwindExpr -> Maybe UnwindExpr
    forall a. a -> Maybe a
    Just (UnwindExpr -> Maybe UnwindExpr) -> UnwindExpr -> Maybe UnwindExpr
    forall a b. (a -> b) -> a -> b
    $ GlobalReg -> Int -> UnwindExpr
    UwReg GlobalReg
    MachSp (Int -> UnwindExpr) -> Int -> UnwindExpr
    forall a b. (a -> b) -> a -> b
    $ Int -> Int
    forall a. Num a => a -> a
    negate Int
    d)
                    OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Instr
    instr, CLabel -> Map GlobalReg (Maybe UnwindExpr) -> Instr
    UNWIND CLabel
    lbl Map GlobalReg (Maybe UnwindExpr)
    unwind ]
            else OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL Instr
    instr)
    addSpUnwindings Instr
    instr = OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL Instr
    instr

    {- Note [Keeping track of the current block]
       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When generating instructions for Cmm we sometimes require
    the current block for things like retry loops.

    We also sometimes change the current block, if a MachOP
    results in branching control flow.

    Issues arise if we have two statements in the same block,
    which both depend on the current block id *and* change the
    basic block after them. This happens for atomic primops
    in the X86 backend where we want to update the CFG data structure
    when introducing new basic blocks.

    For example in #17334 we got this Cmm code:

            c3Bf: // global
                (_s3t1::I64) = call MO_AtomicRMW W64 AMO_And(_s3sQ::P64 + 88, 18);
                (_s3t4::I64) = call MO_AtomicRMW W64 AMO_Or(_s3sQ::P64 + 88, 0);
                _s3sT::I64 = _s3sV::I64;
                goto c3B1;

    This resulted in two new basic blocks being inserted:

            c3Bf:
                    movl $18,%vI_n3Bo
                    movq 88(%vI_s3sQ),%rax
                    jmp _n3Bp
            n3Bp:
                    ...
                    cmpxchgq %vI_n3Bq,88(%vI_s3sQ)
                    jne _n3Bp
                    ...
                    jmp _n3Bs
            n3Bs:
                    ...
                    cmpxchgq %vI_n3Bt,88(%vI_s3sQ)
                    jne _n3Bs
                    ...
                    jmp _c3B1
            ...

    Based on the Cmm we called stmtToInstrs we translated both atomic operations under
    the assumption they would be placed into their Cmm basic block `c3Bf`.
    However for the retry loop we introduce new labels, so this is not the case
    for the second statement.
    This resulted in a desync between the explicit control flow graph
    we construct as a separate data type and the actual control flow graph in the code.

    Instead we now return the new basic block if a statement causes a change
    in the current block and use the block for all following statements.

    For this reason genForeignCall is also split into two parts.  One for calls which
    *won't* change the basic blocks in which successive instructions will be
    placed (since they only evaluate CmmExpr, which can only contain MachOps, which
    cannot introduce basic blocks in their lowerings).  A different one for calls
    which *are* known to change the basic block.

    -}

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

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

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

          CmmUnwind [(GlobalReg, Maybe CmmExpr)]
    regs -> do
            let to_unwind_entry :: (GlobalReg, Maybe CmmExpr) -> UnwindTable
                to_unwind_entry :: (GlobalReg, Maybe CmmExpr) -> Map GlobalReg (Maybe UnwindExpr)
    to_unwind_entry (GlobalReg
    reg, Maybe CmmExpr
    expr) = GlobalReg -> Maybe UnwindExpr -> Map GlobalReg (Maybe UnwindExpr)
    forall k a. k -> a -> Map k a
    M.singleton GlobalReg
    reg ((CmmExpr -> UnwindExpr) -> Maybe CmmExpr -> Maybe UnwindExpr
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Platform -> CmmExpr -> UnwindExpr
    toUnwindExpr Platform
    platform) Maybe CmmExpr
    expr)
            case ((GlobalReg, Maybe CmmExpr) -> Map GlobalReg (Maybe UnwindExpr))
    -> [(GlobalReg, Maybe CmmExpr)] -> Map GlobalReg (Maybe UnwindExpr)
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap (GlobalReg, Maybe CmmExpr) -> Map GlobalReg (Maybe UnwindExpr)
    to_unwind_entry [(GlobalReg, Maybe CmmExpr)]
    regs of
              Map GlobalReg (Maybe UnwindExpr)
    tbl | Map GlobalReg (Maybe UnwindExpr) -> Bool
    forall k a. Map k a -> Bool
    M.null Map GlobalReg (Maybe UnwindExpr)
    tbl -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    forall a. OrdList a
    nilOL
                  | Bool
    otherwise  -> do
                      CLabel
    lbl <- Unique -> CLabel
    forall a. Uniquable a => a -> CLabel
    mkAsmTempLabel (Unique -> CLabel) -> NatM Unique -> NatM CLabel
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NatM Unique
    forall (m :: * -> *). MonadUnique m => m Unique
    getUniqueM
                      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CLabel -> Map GlobalReg (Maybe UnwindExpr) -> Instr
    UNWIND CLabel
    lbl Map GlobalReg (Maybe UnwindExpr)
    tbl

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

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

          CmmBranch Label
    id          -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Label -> OrdList Instr
    genBranch Label
    id

          --We try to arrange blocks such that the likely branch is the fallthrough
          --in GHC.Cmm.ContFlowOpt. So we can assume the condition is likely false here.
          CmmCondBranch CmmExpr
    arg Label
    true Label
    false Maybe Bool
    _ -> Label -> Label -> Label -> CmmExpr -> NatM (OrdList Instr)
    genCondBranch Label
    bid Label
    true Label
    false CmmExpr
    arg
          CmmSwitch CmmExpr
    arg SwitchTargets
    ids -> CmmExpr -> SwitchTargets -> NatM (OrdList Instr)
    genSwitch CmmExpr
    arg SwitchTargets
    ids
          CmmCall { cml_target :: CmmNode O C -> CmmExpr
    cml_target = CmmExpr
    arg
                  , cml_args_regs :: CmmNode O C -> [GlobalReg]
    cml_args_regs = [GlobalReg]
    gregs } -> CmmExpr -> [Reg] -> NatM (OrdList Instr)
    genJump CmmExpr
    arg (Platform -> [GlobalReg] -> [Reg]
    jumpRegs Platform
    platform [GlobalReg]
    gregs)
          CmmNode e x
    _ ->
            String -> NatM (OrdList Instr)
    forall a. String -> a
    panic String
    "stmtToInstrs: statement should have been cps'd away"

    jumpRegs :: Platform -> [GlobalReg] -> [Reg]
    jumpRegs :: Platform -> [GlobalReg] -> [Reg]
    jumpRegs Platform
    platform [GlobalReg]
    gregs = [ RealReg -> Reg
    RegReal RealReg
    r | Just RealReg
    r <- (GlobalReg -> Maybe RealReg) -> [GlobalReg] -> [Maybe RealReg]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> GlobalReg -> Maybe RealReg
    globalRegMaybe Platform
    platform) [GlobalReg]
    gregs ]

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

    -- | Condition codes passed up the tree.
    --
    data CondCode
            = CondCode Bool Cond InstrBlock

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

    swizzleRegisterRep :: Register -> Format -> Register
    swizzleRegisterRep :: Register -> Format -> Register
    swizzleRegisterRep (Fixed Format
    _ Reg
    reg OrdList Instr
    code) Format
    format = Format -> Reg -> OrdList Instr -> Register
    Fixed Format
    format Reg
    reg OrdList Instr
    code
    swizzleRegisterRep (Any Format
    _ Reg -> OrdList Instr
    codefn)     Format
    format = Format -> (Reg -> OrdList Instr) -> Register
    Any   Format
    format Reg -> OrdList Instr
    codefn

    getLocalRegReg :: LocalReg -> Reg
    getLocalRegReg :: LocalReg -> Reg
    getLocalRegReg (LocalReg Unique
    u CmmType
    pk)
      = -- by Assuming SSE2, Int,Word,Float,Double all can be register allocated
        VirtualReg -> Reg
    RegVirtual (Unique -> Format -> VirtualReg
    mkVirtualReg Unique
    u (CmmType -> Format
    cmmTypeFormat CmmType
    pk))

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

    getRegisterReg :: Platform -> CmmReg -> Reg
    getRegisterReg Platform
    _   (CmmLocal LocalReg
    lreg) = LocalReg -> Reg
    getLocalRegReg LocalReg
    lreg

    getRegisterReg Platform
    platform  (CmmGlobal GlobalReg
    mid)
      = case Platform -> GlobalReg -> Maybe RealReg
    globalRegMaybe Platform
    platform GlobalReg
    mid of
            Just RealReg
    reg -> RealReg -> Reg
    RegReal (RealReg -> Reg) -> RealReg -> Reg
    forall a b. (a -> b) -> a -> b
    $ RealReg
    reg
            Maybe RealReg
    Nothing  -> String -> SDoc -> Reg
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegisterReg-memory" (CmmReg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (CmmReg -> SDoc) -> CmmReg -> SDoc
    forall a b. (a -> b) -> a -> b
    $ GlobalReg -> CmmReg
    CmmGlobal GlobalReg
    mid)
            -- By this stage, the only MagicIds remaining should be the
            -- ones which map to a real machine register on this
            -- platform.  Hence ...

    -- | Memory addressing modes passed up the tree.
    data Amode
            = Amode AddrMode InstrBlock

    {-
    Now, given a tree (the argument to a CmmLoad) that references memory,
    produce a suitable addressing mode.

    A Rule of the Game (tm) for Amodes: use of the addr bit must
    immediately follow use of the code part, since the code part puts
    values in registers which the addr then refers to.  So you can't put
    anything in between, lest it overwrite some of those registers.  If
    you need to do some other computation between the code part and use of
    the addr bit, first store the effective address from the amode in a
    temporary, then do the other computation, and then use the temporary:

        code
        LEA amode, tmp
        ... other computation ...
        ... (tmp) ...
    -}

    {-
    Note [%rip-relative addressing on x86-64]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    On x86-64 GHC produces code for use in the "small" or, when `-fPIC` is set,
    "small PIC" code models defined by the x86-64 System V ABI (section 3.5.1 of
    specification version 0.99).

    In general the small code model would allow us to assume that code is located
    between 0 and 2^31 - 1. However, this is not true on Windows which, due to
    high-entropy ASLR, may place the executable image anywhere in 64-bit address
    space. This is problematic since immediate operands in x86-64 are generally
    32-bit sign-extended values (with the exception of the 64-bit MOVABS encoding).
    Consequently, to avoid overflowing we use %rip-relative addressing universally.
    Since %rip-relative addressing comes essentially for free and makes linking far
    easier, we use it even on non-Windows platforms.

    See also: the documentation for GCC's `-mcmodel=small` flag.
    -}

    -- | Check whether an integer will fit in 32 bits.
    --      A CmmInt is intended to be truncated to the appropriate
    --      number of bits, so here we truncate it to Int64.  This is
    --      important because e.g. -1 as a CmmInt might be either
    --      -1 or 18446744073709551615.
    --
    is32BitInteger :: Integer -> Bool
    is32BitInteger :: Integer -> Bool
    is32BitInteger Integer
    i = Int64
    i64 Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int64
    0x7fffffff Bool -> Bool -> Bool
    && Int64
    i64 Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= -Int64
    0x80000000
      where i64 :: Int64
    i64 = Integer -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    i :: Int64

    -- | Convert a BlockId to some CmmStatic data
    jumpTableEntry :: NCGConfig -> Maybe BlockId -> CmmStatic
    jumpTableEntry :: NCGConfig -> Maybe Label -> CmmStatic
    jumpTableEntry NCGConfig
    config Maybe Label
    Nothing = CmmLit -> CmmStatic
    CmmStaticLit (Integer -> Width -> CmmLit
    CmmInt Integer
    0 (NCGConfig -> Width
    ncgWordWidth NCGConfig
    config))
    jumpTableEntry NCGConfig
    _ (Just Label
    blockid) = CmmLit -> CmmStatic
    CmmStaticLit (CLabel -> CmmLit
    CmmLabel CLabel
    blockLabel)
        where blockLabel :: CLabel
    blockLabel = Label -> CLabel
    blockLbl Label
    blockid

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

    -- Expand CmmRegOff.  ToDo: should we do it this way around, or convert
    -- CmmExprs into CmmRegOff?
    mangleIndexTree :: Platform -> CmmReg -> Int -> CmmExpr
    mangleIndexTree :: Platform -> CmmReg -> Int -> CmmExpr
    mangleIndexTree Platform
    platform CmmReg
    reg Int
    off
      = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_Add Width
    width) [CmmReg -> CmmExpr
    CmmReg CmmReg
    reg, CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    off) Width
    width)]
      where width :: Width
    width = CmmType -> Width
    typeWidth (Platform -> CmmReg -> CmmType
    cmmRegType Platform
    platform CmmReg
    reg)

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

    assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
    assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_I64Code CmmExpr
    addrTree CmmExpr
    valueTree = do
      Amode AddrMode
    addr OrdList Instr
    addr_code <- CmmExpr -> NatM Amode
    getAmode CmmExpr
    addrTree
      RegCode64 OrdList Instr
    vcode Reg
    rhi Reg
    rlo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    valueTree
      let
            -- Little-endian store
            mov_lo :: Instr
    mov_lo = Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    rlo) (AddrMode -> Operand
    OpAddr AddrMode
    addr)
            mov_hi :: Instr
    mov_hi = Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    rhi) (AddrMode -> Operand
    OpAddr (Maybe AddrMode -> AddrMode
    forall a. HasCallStack => Maybe a -> a
    fromJust (AddrMode -> Int -> Maybe AddrMode
    addrOffset AddrMode
    addr Int
    4)))
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    vcode OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_lo OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_hi)

    assignReg_I64Code :: CmmReg  -> CmmExpr -> NatM InstrBlock
    assignReg_I64Code :: CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_I64Code (CmmLocal LocalReg
    dst) CmmExpr
    valueTree = do
       RegCode64 OrdList Instr
    vcode Reg
    r_src_hi Reg
    r_src_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    valueTree
       let
             Reg64 Reg
    r_dst_hi Reg
    r_dst_lo = (() :: Constraint) => LocalReg -> Reg64
    LocalReg -> Reg64
    localReg64 LocalReg
    dst
             mov_lo :: Instr
    mov_lo = Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    r_src_lo) (Reg -> Operand
    OpReg Reg
    r_dst_lo)
             mov_hi :: Instr
    mov_hi = Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    r_src_hi) (Reg -> Operand
    OpReg Reg
    r_dst_hi)
       OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (
            OrdList Instr
    vcode OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_lo OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_hi
         )

    assignReg_I64Code CmmReg
    _ CmmExpr
    _
       = String -> NatM (OrdList Instr)
    forall a. String -> a
    panic String
    "assignReg_I64Code(i386): invalid lvalue"

    iselExpr64 :: HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
    iselExpr64 :: (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 (CmmLit (CmmInt Integer
    i Width
    _)) = do
      Reg64 Reg
    rhi Reg
    rlo <- NatM Reg64
    getNewReg64
      let
            r :: Integer
    r = Word32 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    i :: Word32)
            q :: Integer
    q = Word32 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer
    i Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    32) :: Word32)
            code :: OrdList Instr
    code = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                    Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    r)) (Reg -> Operand
    OpReg Reg
    rlo),
                    Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    q)) (Reg -> Operand
    OpReg Reg
    rhi)
                    ]
      RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> Reg -> Reg -> RegCode64 (OrdList Instr)
    forall code. code -> Reg -> Reg -> RegCode64 code
    RegCode64 OrdList Instr
    code Reg
    rhi Reg
    rlo)

    iselExpr64 (CmmLoad CmmExpr
    addrTree CmmType
    ty AlignmentSpec
    _) | CmmType -> Bool
    isWord64 CmmType
    ty = do
       Amode AddrMode
    addr OrdList Instr
    addr_code <- CmmExpr -> NatM Amode
    getAmode CmmExpr
    addrTree
       Reg64 Reg
    rhi Reg
    rlo <- NatM Reg64
    getNewReg64
       let
            mov_lo :: Instr
    mov_lo = Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (AddrMode -> Operand
    OpAddr AddrMode
    addr) (Reg -> Operand
    OpReg Reg
    rlo)
            mov_hi :: Instr
    mov_hi = Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (AddrMode -> Operand
    OpAddr (Maybe AddrMode -> AddrMode
    forall a. HasCallStack => Maybe a -> a
    fromJust (AddrMode -> Int -> Maybe AddrMode
    addrOffset AddrMode
    addr Int
    4))) (Reg -> Operand
    OpReg Reg
    rhi)
       RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (
                OrdList Instr -> Reg -> Reg -> RegCode64 (OrdList Instr)
    forall code. code -> Reg -> Reg -> RegCode64 code
    RegCode64 (OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_lo OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_hi) Reg
    rhi Reg
    rlo
         )

    iselExpr64 (CmmReg (CmmLocal LocalReg
    local_reg)) = do
      let Reg64 Reg
    hi Reg
    lo = (() :: Constraint) => LocalReg -> Reg64
    LocalReg -> Reg64
    localReg64 LocalReg
    local_reg
      RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> Reg -> Reg -> RegCode64 (OrdList Instr)
    forall code. code -> Reg -> Reg -> RegCode64 code
    RegCode64 OrdList Instr
    forall a. OrdList a
    nilOL Reg
    hi Reg
    lo)

    -- we handle addition, but rather badly
    iselExpr64 (CmmMachOp (MO_Add Width
    _) [CmmExpr
    e1, CmmLit (CmmInt Integer
    i Width
    _)]) = do
       RegCode64 OrdList Instr
    code1 Reg
    r1hi Reg
    r1lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    e1
       Reg64 Reg
    rhi Reg
    rlo <- NatM Reg64
    getNewReg64
       let
            r :: Integer
    r = Word32 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    i :: Word32)
            q :: Integer
    q = Word32 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer
    i Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    32) :: Word32)
            code :: OrdList Instr
    code =  OrdList Instr
    code1 OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    r1lo) (Reg -> Operand
    OpReg Reg
    rlo),
                           Format -> Operand -> Operand -> Instr
    ADD Format
    II32 (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    r)) (Reg -> Operand
    OpReg Reg
    rlo),
                           Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    r1hi) (Reg -> Operand
    OpReg Reg
    rhi),
                           Format -> Operand -> Operand -> Instr
    ADC Format
    II32 (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    q)) (Reg -> Operand
    OpReg Reg
    rhi) ]
       RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> Reg -> Reg -> RegCode64 (OrdList Instr)
    forall code. code -> Reg -> Reg -> RegCode64 code
    RegCode64 OrdList Instr
    code Reg
    rhi Reg
    rlo)

    iselExpr64 (CmmMachOp (MO_Add Width
    _) [CmmExpr
    e1,CmmExpr
    e2]) = do
       RegCode64 OrdList Instr
    code1 Reg
    r1hi Reg
    r1lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    e1
       RegCode64 OrdList Instr
    code2 Reg
    r2hi Reg
    r2lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    e2
       Reg64 Reg
    rhi Reg
    rlo <- NatM Reg64
    getNewReg64
       let
            code :: OrdList Instr
    code =  OrdList Instr
    code1 OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    OrdList Instr
    code2 OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    r1lo) (Reg -> Operand
    OpReg Reg
    rlo),
                           Format -> Operand -> Operand -> Instr
    ADD Format
    II32 (Reg -> Operand
    OpReg Reg
    r2lo) (Reg -> Operand
    OpReg Reg
    rlo),
                           Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    r1hi) (Reg -> Operand
    OpReg Reg
    rhi),
                           Format -> Operand -> Operand -> Instr
    ADC Format
    II32 (Reg -> Operand
    OpReg Reg
    r2hi) (Reg -> Operand
    OpReg Reg
    rhi) ]
       RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> Reg -> Reg -> RegCode64 (OrdList Instr)
    forall code. code -> Reg -> Reg -> RegCode64 code
    RegCode64 OrdList Instr
    code Reg
    rhi Reg
    rlo)

    iselExpr64 (CmmMachOp (MO_Sub Width
    _) [CmmExpr
    e1,CmmExpr
    e2]) = do
       RegCode64 OrdList Instr
    code1 Reg
    r1hi Reg
    r1lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    e1
       RegCode64 OrdList Instr
    code2 Reg
    r2hi Reg
    r2lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    e2
       Reg64 Reg
    rhi Reg
    rlo <- NatM Reg64
    getNewReg64
       let
            code :: OrdList Instr
    code =  OrdList Instr
    code1 OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    OrdList Instr
    code2 OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    r1lo) (Reg -> Operand
    OpReg Reg
    rlo),
                           Format -> Operand -> Operand -> Instr
    SUB Format
    II32 (Reg -> Operand
    OpReg Reg
    r2lo) (Reg -> Operand
    OpReg Reg
    rlo),
                           Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    r1hi) (Reg -> Operand
    OpReg Reg
    rhi),
                           Format -> Operand -> Operand -> Instr
    SBB Format
    II32 (Reg -> Operand
    OpReg Reg
    r2hi) (Reg -> Operand
    OpReg Reg
    rhi) ]
       RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> Reg -> Reg -> RegCode64 (OrdList Instr)
    forall code. code -> Reg -> Reg -> RegCode64 code
    RegCode64 OrdList Instr
    code Reg
    rhi Reg
    rlo)

    iselExpr64 (CmmMachOp (MO_UU_Conv Width
    _ Width
    W64) [CmmExpr
    expr]) = do
         Reg -> OrdList Instr
    code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    expr
         Reg64 Reg
    r_dst_hi Reg
    r_dst_lo <- NatM Reg64
    getNewReg64
         RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr)))
    -> RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr -> Reg -> Reg -> RegCode64 (OrdList Instr)
    forall code. code -> Reg -> Reg -> RegCode64 code
    RegCode64 (Reg -> OrdList Instr
    code Reg
    r_dst_lo OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                              Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    0)) (Reg -> Operand
    OpReg Reg
    r_dst_hi))
                              Reg
    r_dst_hi
                              Reg
    r_dst_lo

    iselExpr64 (CmmMachOp (MO_SS_Conv Width
    W32 Width
    W64) [CmmExpr
    expr]) = do
         Reg -> OrdList Instr
    code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    expr
         Reg64 Reg
    r_dst_hi Reg
    r_dst_lo <- NatM Reg64
    getNewReg64
         RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr)))
    -> RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr -> Reg -> Reg -> RegCode64 (OrdList Instr)
    forall code. code -> Reg -> Reg -> RegCode64 code
    RegCode64 (Reg -> OrdList Instr
    code Reg
    r_dst_lo OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                              Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    r_dst_lo) (Reg -> Operand
    OpReg Reg
    eax) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                              Format -> Instr
    CLTD Format
    II32 OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                              Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    eax) (Reg -> Operand
    OpReg Reg
    r_dst_lo) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                              Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    edx) (Reg -> Operand
    OpReg Reg
    r_dst_hi))
                              Reg
    r_dst_hi
                              Reg
    r_dst_lo

    iselExpr64 CmmExpr
    expr
       = do
          Platform
    platform <- NatM Platform
    getPlatform
          String -> SDoc -> NatM (RegCode64 (OrdList Instr))
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "iselExpr64(i386)" (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    expr)

    --------------------------------------------------------------------------------
    getRegister :: CmmExpr -> NatM Register
    getRegister :: CmmExpr -> NatM Register
    getRegister CmmExpr
    e = do Platform
    platform <- NatM Platform
    getPlatform
                       Bool
    is32Bit <- NatM Bool
    is32BitPlatform
                       Platform -> Bool -> CmmExpr -> NatM Register
    getRegister' Platform
    platform Bool
    is32Bit CmmExpr
    e

    getRegister' :: Platform -> Bool -> CmmExpr -> NatM Register

    getRegister' :: Platform -> Bool -> CmmExpr -> NatM Register
    getRegister' Platform
    platform Bool
    is32Bit (CmmReg CmmReg
    reg)
      = case CmmReg
    reg of
            CmmGlobal GlobalReg
    PicBaseReg
             | Bool
    is32Bit ->
                -- on x86_64, we have %rip for PicBaseReg, but it's not
                -- a full-featured register, it can only be used for
                -- rip-relative addressing.
                do Reg
    reg' <- Format -> NatM Reg
    getPicBaseNat (Bool -> Format
    archWordFormat Bool
    is32Bit)
                   Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> Reg -> OrdList Instr -> Register
    Fixed (Bool -> Format
    archWordFormat Bool
    is32Bit) Reg
    reg' OrdList Instr
    forall a. OrdList a
    nilOL)
            CmmReg
    _ ->
                do
                   let
                     fmt :: Format
    fmt = CmmType -> Format
    cmmTypeFormat (Platform -> CmmReg -> CmmType
    cmmRegType Platform
    platform CmmReg
    reg)
                     format :: Format
    format  = Format
    fmt
                   --
                   Platform
    platform <- NCGConfig -> Platform
    ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NatM NCGConfig
    getConfig
                   Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> Reg -> OrdList Instr -> Register
    Fixed Format
    format
                                 (Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform CmmReg
    reg)
                                 OrdList Instr
    forall a. OrdList a
    nilOL)

    getRegister' Platform
    platform Bool
    is32Bit (CmmRegOff CmmReg
    r Int
    n)
      = Platform -> Bool -> CmmExpr -> NatM Register
    getRegister' Platform
    platform Bool
    is32Bit (CmmExpr -> NatM Register) -> CmmExpr -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Platform -> CmmReg -> Int -> CmmExpr
    mangleIndexTree Platform
    platform CmmReg
    r Int
    n

    getRegister' Platform
    platform Bool
    is32Bit (CmmMachOp (MO_AlignmentCheck Int
    align Width
    _) [CmmExpr
    e])
      = Int -> Register -> Register
    addAlignmentCheck Int
    align (Register -> Register) -> NatM Register -> NatM Register
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Platform -> Bool -> CmmExpr -> NatM Register
    getRegister' Platform
    platform Bool
    is32Bit CmmExpr
    e

    -- for 32-bit architectures, support some 64 -> 32 bit conversions:
    -- TO_W_(x), TO_W_(x >> 32)

    getRegister' Platform
    _ Bool
    is32Bit (CmmMachOp (MO_UU_Conv Width
    W64 Width
    W32)
                         [CmmMachOp (MO_U_Shr Width
    W64) [CmmExpr
    x,CmmLit (CmmInt Integer
    32 Width
    _)]])
     | Bool
    is32Bit = do
      RegCode64 OrdList Instr
    code Reg
    rhi Reg
    _rlo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> OrdList Instr -> Register
    Fixed Format
    II32 Reg
    rhi OrdList Instr
    code

    getRegister' Platform
    _ Bool
    is32Bit (CmmMachOp (MO_SS_Conv Width
    W64 Width
    W32)
                         [CmmMachOp (MO_U_Shr Width
    W64) [CmmExpr
    x,CmmLit (CmmInt Integer
    32 Width
    _)]])
     | Bool
    is32Bit = do
      RegCode64 OrdList Instr
    code Reg
    rhi Reg
    _rlo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> OrdList Instr -> Register
    Fixed Format
    II32 Reg
    rhi OrdList Instr
    code

    getRegister' Platform
    _ Bool
    is32Bit (CmmMachOp (MO_UU_Conv Width
    W64 Width
    W32) [CmmExpr
    x])
     | Bool
    is32Bit = do
      RegCode64 OrdList Instr
    code Reg
    _rhi Reg
    rlo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> OrdList Instr -> Register
    Fixed Format
    II32 Reg
    rlo OrdList Instr
    code

    getRegister' Platform
    _ Bool
    is32Bit (CmmMachOp (MO_SS_Conv Width
    W64 Width
    W32) [CmmExpr
    x])
     | Bool
    is32Bit = do
      RegCode64 OrdList Instr
    code Reg
    _rhi Reg
    rlo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> OrdList Instr -> Register
    Fixed Format
    II32 Reg
    rlo OrdList Instr
    code

    getRegister' Platform
    _ Bool
    _ (CmmLit lit :: CmmLit
    lit@(CmmFloat Rational
    f Width
    w)) =
      NatM Register
    float_const_sse2  where
      float_const_sse2 :: NatM Register
    float_const_sse2
        | Rational
    f Rational -> Rational -> Bool
    forall a. Eq a => a -> a -> Bool
    == Rational
    0.0 = do
          let
              format :: Format
    format = Width -> Format
    floatFormat Width
    w
              code :: Reg -> OrdList Instr
    code Reg
    dst = Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL  (Format -> Operand -> Operand -> Instr
    XOR Format
    format (Reg -> Operand
    OpReg Reg
    dst) (Reg -> Operand
    OpReg Reg
    dst))
            -- I don't know why there are xorpd, xorps, and pxor instructions.
            -- They all appear to do the same thing --SDM
          Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format Reg -> OrdList Instr
    code)

       | Bool
    otherwise = do
          Amode AddrMode
    addr OrdList Instr
    code <- Alignment -> CmmLit -> NatM Amode
    memConstant (Int -> Alignment
    mkAlignment (Int -> Alignment) -> Int -> Alignment
    forall a b. (a -> b) -> a -> b
    $ Width -> Int
    widthInBytes Width
    w) CmmLit
    lit
          Width -> AddrMode -> OrdList Instr -> NatM Register
    loadFloatAmode Width
    w AddrMode
    addr OrdList Instr
    code

    -- catch simple cases of zero- or sign-extended load
    getRegister' Platform
    _ Bool
    _ (CmmMachOp (MO_UU_Conv Width
    W8 Width
    W32) [CmmLoad CmmExpr
    addr CmmType
    _ AlignmentSpec
    _]) = do
      Reg -> OrdList Instr
    code <- (Operand -> Operand -> Instr)
    -> CmmExpr -> NatM (Reg -> OrdList Instr)
    intLoadCode (Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II8) CmmExpr
    addr
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II32 Reg -> OrdList Instr
    code)

    getRegister' Platform
    _ Bool
    _ (CmmMachOp (MO_SS_Conv Width
    W8 Width
    W32) [CmmLoad CmmExpr
    addr CmmType
    _ AlignmentSpec
    _]) = do
      Reg -> OrdList Instr
    code <- (Operand -> Operand -> Instr)
    -> CmmExpr -> NatM (Reg -> OrdList Instr)
    intLoadCode (Format -> Operand -> Operand -> Instr
    MOVSxL Format
    II8) CmmExpr
    addr
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II32 Reg -> OrdList Instr
    code)

    getRegister' Platform
    _ Bool
    _ (CmmMachOp (MO_UU_Conv Width
    W16 Width
    W32) [CmmLoad CmmExpr
    addr CmmType
    _ AlignmentSpec
    _]) = do
      Reg -> OrdList Instr
    code <- (Operand -> Operand -> Instr)
    -> CmmExpr -> NatM (Reg -> OrdList Instr)
    intLoadCode (Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II16) CmmExpr
    addr
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II32 Reg -> OrdList Instr
    code)

    getRegister' Platform
    _ Bool
    _ (CmmMachOp (MO_SS_Conv Width
    W16 Width
    W32) [CmmLoad CmmExpr
    addr CmmType
    _ AlignmentSpec
    _]) = do
      Reg -> OrdList Instr
    code <- (Operand -> Operand -> Instr)
    -> CmmExpr -> NatM (Reg -> OrdList Instr)
    intLoadCode (Format -> Operand -> Operand -> Instr
    MOVSxL Format
    II16) CmmExpr
    addr
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II32 Reg -> OrdList Instr
    code)

    -- catch simple cases of zero- or sign-extended load
    getRegister' Platform
    _ Bool
    is32Bit (CmmMachOp (MO_UU_Conv Width
    W8 Width
    W64) [CmmLoad CmmExpr
    addr CmmType
    _ AlignmentSpec
    _])
     | Bool -> Bool
    not Bool
    is32Bit = do
      Reg -> OrdList Instr
    code <- (Operand -> Operand -> Instr)
    -> CmmExpr -> NatM (Reg -> OrdList Instr)
    intLoadCode (Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II8) CmmExpr
    addr
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II64 Reg -> OrdList Instr
    code)

    getRegister' Platform
    _ Bool
    is32Bit (CmmMachOp (MO_SS_Conv Width
    W8 Width
    W64) [CmmLoad CmmExpr
    addr CmmType
    _ AlignmentSpec
    _])
     | Bool -> Bool
    not Bool
    is32Bit = do
      Reg -> OrdList Instr
    code <- (Operand -> Operand -> Instr)
    -> CmmExpr -> NatM (Reg -> OrdList Instr)
    intLoadCode (Format -> Operand -> Operand -> Instr
    MOVSxL Format
    II8) CmmExpr
    addr
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II64 Reg -> OrdList Instr
    code)

    getRegister' Platform
    _ Bool
    is32Bit (CmmMachOp (MO_UU_Conv Width
    W16 Width
    W64) [CmmLoad CmmExpr
    addr CmmType
    _ AlignmentSpec
    _])
     | Bool -> Bool
    not Bool
    is32Bit = do
      Reg -> OrdList Instr
    code <- (Operand -> Operand -> Instr)
    -> CmmExpr -> NatM (Reg -> OrdList Instr)
    intLoadCode (Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II16) CmmExpr
    addr
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II64 Reg -> OrdList Instr
    code)

    getRegister' Platform
    _ Bool
    is32Bit (CmmMachOp (MO_SS_Conv Width
    W16 Width
    W64) [CmmLoad CmmExpr
    addr CmmType
    _ AlignmentSpec
    _])
     | Bool -> Bool
    not Bool
    is32Bit = do
      Reg -> OrdList Instr
    code <- (Operand -> Operand -> Instr)
    -> CmmExpr -> NatM (Reg -> OrdList Instr)
    intLoadCode (Format -> Operand -> Operand -> Instr
    MOVSxL Format
    II16) CmmExpr
    addr
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II64 Reg -> OrdList Instr
    code)

    getRegister' Platform
    _ Bool
    is32Bit (CmmMachOp (MO_UU_Conv Width
    W32 Width
    W64) [CmmLoad CmmExpr
    addr CmmType
    _ AlignmentSpec
    _])
     | Bool -> Bool
    not Bool
    is32Bit = do
      Reg -> OrdList Instr
    code <- (Operand -> Operand -> Instr)
    -> CmmExpr -> NatM (Reg -> OrdList Instr)
    intLoadCode (Format -> Operand -> Operand -> Instr
    MOV Format
    II32) CmmExpr
    addr -- 32-bit loads zero-extend
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II64 Reg -> OrdList Instr
    code)

    getRegister' Platform
    _ Bool
    is32Bit (CmmMachOp (MO_SS_Conv Width
    W32 Width
    W64) [CmmLoad CmmExpr
    addr CmmType
    _ AlignmentSpec
    _])
     | Bool -> Bool
    not Bool
    is32Bit = do
      Reg -> OrdList Instr
    code <- (Operand -> Operand -> Instr)
    -> CmmExpr -> NatM (Reg -> OrdList Instr)
    intLoadCode (Format -> Operand -> Operand -> Instr
    MOVSxL Format
    II32) CmmExpr
    addr
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II64 Reg -> OrdList Instr
    code)

    getRegister' Platform
    _ Bool
    is32Bit (CmmMachOp (MO_Add Width
    W64) [CmmReg (CmmGlobal GlobalReg
    PicBaseReg),
                                         CmmLit CmmLit
    displacement])
     | Bool -> Bool
    not Bool
    is32Bit =
          Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II64 (\Reg
    dst -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $
            Format -> Operand -> Operand -> Instr
    LEA Format
    II64 (AddrMode -> Operand
    OpAddr (Imm -> AddrMode
    ripRel (CmmLit -> Imm
    litToImm CmmLit
    displacement))) (Reg -> Operand
    OpReg Reg
    dst))

    getRegister' Platform
    platform Bool
    is32Bit (CmmMachOp MachOp
    mop [CmmExpr
    x]) = -- unary MachOps
        case MachOp
    mop of
          MO_F_Neg Width
    w  -> Width -> CmmExpr -> NatM Register
    sse2NegCode Width
    w CmmExpr
    x

          MO_S_Neg Width
    w -> (Format -> Operand -> Instr) -> Format -> NatM Register
    triv_ucode Format -> Operand -> Instr
    NEGI (Width -> Format
    intFormat Width
    w)
          MO_Not Width
    w   -> (Format -> Operand -> Instr) -> Format -> NatM Register
    triv_ucode Format -> Operand -> Instr
    NOT  (Width -> Format
    intFormat Width
    w)

          -- Nop conversions
          MO_UU_Conv Width
    W32 Width
    W8  -> Width -> CmmExpr -> NatM Register
    toI8Reg  Width
    W32 CmmExpr
    x
          MO_SS_Conv Width
    W32 Width
    W8  -> Width -> CmmExpr -> NatM Register
    toI8Reg  Width
    W32 CmmExpr
    x
          MO_XX_Conv Width
    W32 Width
    W8  -> Width -> CmmExpr -> NatM Register
    toI8Reg  Width
    W32 CmmExpr
    x
          MO_UU_Conv Width
    W16 Width
    W8  -> Width -> CmmExpr -> NatM Register
    toI8Reg  Width
    W16 CmmExpr
    x
          MO_SS_Conv Width
    W16 Width
    W8  -> Width -> CmmExpr -> NatM Register
    toI8Reg  Width
    W16 CmmExpr
    x
          MO_XX_Conv Width
    W16 Width
    W8  -> Width -> CmmExpr -> NatM Register
    toI8Reg  Width
    W16 CmmExpr
    x
          MO_UU_Conv Width
    W32 Width
    W16 -> Width -> CmmExpr -> NatM Register
    toI16Reg Width
    W32 CmmExpr
    x
          MO_SS_Conv Width
    W32 Width
    W16 -> Width -> CmmExpr -> NatM Register
    toI16Reg Width
    W32 CmmExpr
    x
          MO_XX_Conv Width
    W32 Width
    W16 -> Width -> CmmExpr -> NatM Register
    toI16Reg Width
    W32 CmmExpr
    x

          MO_UU_Conv Width
    W64 Width
    W32 | Bool -> Bool
    not Bool
    is32Bit -> Format -> CmmExpr -> NatM Register
    conversionNop Format
    II64 CmmExpr
    x
          MO_SS_Conv Width
    W64 Width
    W32 | Bool -> Bool
    not Bool
    is32Bit -> Format -> CmmExpr -> NatM Register
    conversionNop Format
    II64 CmmExpr
    x
          MO_XX_Conv Width
    W64 Width
    W32 | Bool -> Bool
    not Bool
    is32Bit -> Format -> CmmExpr -> NatM Register
    conversionNop Format
    II64 CmmExpr
    x
          MO_UU_Conv Width
    W64 Width
    W16 | Bool -> Bool
    not Bool
    is32Bit -> Width -> CmmExpr -> NatM Register
    toI16Reg Width
    W64 CmmExpr
    x
          MO_SS_Conv Width
    W64 Width
    W16 | Bool -> Bool
    not Bool
    is32Bit -> Width -> CmmExpr -> NatM Register
    toI16Reg Width
    W64 CmmExpr
    x
          MO_XX_Conv Width
    W64 Width
    W16 | Bool -> Bool
    not Bool
    is32Bit -> Width -> CmmExpr -> NatM Register
    toI16Reg Width
    W64 CmmExpr
    x
          MO_UU_Conv Width
    W64 Width
    W8  | Bool -> Bool
    not Bool
    is32Bit -> Width -> CmmExpr -> NatM Register
    toI8Reg  Width
    W64 CmmExpr
    x
          MO_SS_Conv Width
    W64 Width
    W8  | Bool -> Bool
    not Bool
    is32Bit -> Width -> CmmExpr -> NatM Register
    toI8Reg  Width
    W64 CmmExpr
    x
          MO_XX_Conv Width
    W64 Width
    W8  | Bool -> Bool
    not Bool
    is32Bit -> Width -> CmmExpr -> NatM Register
    toI8Reg  Width
    W64 CmmExpr
    x

          MO_UU_Conv Width
    rep1 Width
    rep2 | Width
    rep1 Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    rep2 -> Format -> CmmExpr -> NatM Register
    conversionNop (Width -> Format
    intFormat Width
    rep1) CmmExpr
    x
          MO_SS_Conv Width
    rep1 Width
    rep2 | Width
    rep1 Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    rep2 -> Format -> CmmExpr -> NatM Register
    conversionNop (Width -> Format
    intFormat Width
    rep1) CmmExpr
    x
          MO_XX_Conv Width
    rep1 Width
    rep2 | Width
    rep1 Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    rep2 -> Format -> CmmExpr -> NatM Register
    conversionNop (Width -> Format
    intFormat Width
    rep1) CmmExpr
    x

          -- widenings
          MO_UU_Conv Width
    W8  Width
    W32 -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W8  Width
    W32 Format -> Operand -> Operand -> Instr
    MOVZxL CmmExpr
    x
          MO_UU_Conv Width
    W16 Width
    W32 -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W16 Width
    W32 Format -> Operand -> Operand -> Instr
    MOVZxL CmmExpr
    x
          MO_UU_Conv Width
    W8  Width
    W16 -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W8  Width
    W16 Format -> Operand -> Operand -> Instr
    MOVZxL CmmExpr
    x

          MO_SS_Conv Width
    W8  Width
    W32 -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W8  Width
    W32 Format -> Operand -> Operand -> Instr
    MOVSxL CmmExpr
    x
          MO_SS_Conv Width
    W16 Width
    W32 -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W16 Width
    W32 Format -> Operand -> Operand -> Instr
    MOVSxL CmmExpr
    x
          MO_SS_Conv Width
    W8  Width
    W16 -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W8  Width
    W16 Format -> Operand -> Operand -> Instr
    MOVSxL CmmExpr
    x

          -- We don't care about the upper bits for MO_XX_Conv, so MOV is enough. However, on 32-bit we
          -- have 8-bit registers only for a few registers (as opposed to x86-64 where every register
          -- has 8-bit version). So for 32-bit code, we'll just zero-extend.
          MO_XX_Conv Width
    W8  Width
    W32
              | Bool
    is32Bit   -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W8 Width
    W32 Format -> Operand -> Operand -> Instr
    MOVZxL CmmExpr
    x
              | Bool
    otherwise -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W8 Width
    W32 Format -> Operand -> Operand -> Instr
    MOV CmmExpr
    x
          MO_XX_Conv Width
    W8  Width
    W16
              | Bool
    is32Bit   -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W8 Width
    W16 Format -> Operand -> Operand -> Instr
    MOVZxL CmmExpr
    x
              | Bool
    otherwise -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W8 Width
    W16 Format -> Operand -> Operand -> Instr
    MOV CmmExpr
    x
          MO_XX_Conv Width
    W16 Width
    W32 -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W16 Width
    W32 Format -> Operand -> Operand -> Instr
    MOV CmmExpr
    x

          MO_UU_Conv Width
    W8  Width
    W64 | Bool -> Bool
    not Bool
    is32Bit -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W8  Width
    W64 Format -> Operand -> Operand -> Instr
    MOVZxL CmmExpr
    x
          MO_UU_Conv Width
    W16 Width
    W64 | Bool -> Bool
    not Bool
    is32Bit -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W16 Width
    W64 Format -> Operand -> Operand -> Instr
    MOVZxL CmmExpr
    x
          MO_UU_Conv Width
    W32 Width
    W64 | Bool -> Bool
    not Bool
    is32Bit -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W32 Width
    W64 Format -> Operand -> Operand -> Instr
    MOVZxL CmmExpr
    x
          MO_SS_Conv Width
    W8  Width
    W64 | Bool -> Bool
    not Bool
    is32Bit -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W8  Width
    W64 Format -> Operand -> Operand -> Instr
    MOVSxL CmmExpr
    x
          MO_SS_Conv Width
    W16 Width
    W64 | Bool -> Bool
    not Bool
    is32Bit -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W16 Width
    W64 Format -> Operand -> Operand -> Instr
    MOVSxL CmmExpr
    x
          MO_SS_Conv Width
    W32 Width
    W64 | Bool -> Bool
    not Bool
    is32Bit -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W32 Width
    W64 Format -> Operand -> Operand -> Instr
    MOVSxL CmmExpr
    x
          -- For 32-to-64 bit zero extension, amd64 uses an ordinary movl.
          -- However, we don't want the register allocator to throw it
          -- away as an unnecessary reg-to-reg move, so we keep it in
          -- the form of a movzl and print it as a movl later.
          -- This doesn't apply to MO_XX_Conv since in this case we don't care about
          -- the upper bits. So we can just use MOV.
          MO_XX_Conv Width
    W8  Width
    W64 | Bool -> Bool
    not Bool
    is32Bit -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W8  Width
    W64 Format -> Operand -> Operand -> Instr
    MOV CmmExpr
    x
          MO_XX_Conv Width
    W16 Width
    W64 | Bool -> Bool
    not Bool
    is32Bit -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W16 Width
    W64 Format -> Operand -> Operand -> Instr
    MOV CmmExpr
    x
          MO_XX_Conv Width
    W32 Width
    W64 | Bool -> Bool
    not Bool
    is32Bit -> Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    W32 Width
    W64 Format -> Operand -> Operand -> Instr
    MOV CmmExpr
    x

          MO_FF_Conv Width
    W32 Width
    W64 -> Width -> CmmExpr -> NatM Register
    coerceFP2FP Width
    W64 CmmExpr
    x

          MO_FF_Conv Width
    W64 Width
    W32 -> Width -> CmmExpr -> NatM Register
    coerceFP2FP Width
    W32 CmmExpr
    x

          MO_FS_Conv Width
    from Width
    to -> Width -> Width -> CmmExpr -> NatM Register
    coerceFP2Int Width
    from Width
    to CmmExpr
    x
          MO_SF_Conv Width
    from Width
    to -> Width -> Width -> CmmExpr -> NatM Register
    coerceInt2FP Width
    from Width
    to CmmExpr
    x

          MO_V_Insert {}   -> NatM Register
    forall a. NatM a
    needLlvm
          MO_V_Extract {}  -> NatM Register
    forall a. NatM a
    needLlvm
          MO_V_Add {}      -> NatM Register
    forall a. NatM a
    needLlvm
          MO_V_Sub {}      -> NatM Register
    forall a. NatM a
    needLlvm
          MO_V_Mul {}      -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VS_Quot {}    -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VS_Rem {}     -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VS_Neg {}     -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VU_Quot {}    -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VU_Rem {}     -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VF_Insert {}  -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VF_Extract {} -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VF_Add {}     -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VF_Sub {}     -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VF_Mul {}     -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VF_Quot {}    -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VF_Neg {}     -> NatM Register
    forall a. NatM a
    needLlvm

          MachOp
    _other -> String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister" (MachOp -> SDoc
    pprMachOp MachOp
    mop)
       where
            triv_ucode :: (Format -> Operand -> Instr) -> Format -> NatM Register
            triv_ucode :: (Format -> Operand -> Instr) -> Format -> NatM Register
    triv_ucode Format -> Operand -> Instr
    instr Format
    format = Format -> (Operand -> Instr) -> CmmExpr -> NatM Register
    trivialUCode Format
    format (Format -> Operand -> Instr
    instr Format
    format) CmmExpr
    x

            -- signed or unsigned extension.
            integerExtend :: Width -> Width
                          -> (Format -> Operand -> Operand -> Instr)
                          -> CmmExpr -> NatM Register
            integerExtend :: Width
    -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> NatM Register
    integerExtend Width
    from Width
    to Format -> Operand -> Operand -> Instr
    instr CmmExpr
    expr = do
                (Reg
    reg,OrdList Instr
    e_code) <- if Width
    from Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8 then CmmExpr -> NatM (Reg, OrdList Instr)
    getByteReg CmmExpr
    expr
                                              else CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    expr
                let
                    code :: Reg -> OrdList Instr
    code Reg
    dst =
                      OrdList Instr
    e_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                      Format -> Operand -> Operand -> Instr
    instr (Width -> Format
    intFormat Width
    from) (Reg -> Operand
    OpReg Reg
    reg) (Reg -> Operand
    OpReg Reg
    dst)
                Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    to) Reg -> OrdList Instr
    code)

            toI8Reg :: Width -> CmmExpr -> NatM Register
            toI8Reg :: Width -> CmmExpr -> NatM Register
    toI8Reg Width
    new_rep CmmExpr
    expr
                = do Reg -> OrdList Instr
    codefn <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    expr
                     Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    new_rep) Reg -> OrdList Instr
    codefn)
                    -- HACK: use getAnyReg to get a byte-addressable register.
                    -- If the source was a Fixed register, this will add the
                    -- mov instruction to put it into the desired destination.
                    -- We're assuming that the destination won't be a fixed
                    -- non-byte-addressable register; it won't be, because all
                    -- fixed registers are word-sized.

            toI16Reg :: Width -> CmmExpr -> NatM Register
    toI16Reg = Width -> CmmExpr -> NatM Register
    toI8Reg -- for now

            conversionNop :: Format -> CmmExpr -> NatM Register
            conversionNop :: Format -> CmmExpr -> NatM Register
    conversionNop Format
    new_format CmmExpr
    expr
                = do Register
    e_code <- Platform -> Bool -> CmmExpr -> NatM Register
    getRegister' Platform
    platform Bool
    is32Bit CmmExpr
    expr
                     Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> Format -> Register
    swizzleRegisterRep Register
    e_code Format
    new_format)

    getRegister' Platform
    _ Bool
    is32Bit (CmmMachOp MachOp
    mop [CmmExpr
    x, CmmExpr
    y]) = -- dyadic MachOps
      case MachOp
    mop of
          MO_F_Eq Width
    _ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg Bool
    is32Bit Cond
    EQQ CmmExpr
    x CmmExpr
    y
          MO_F_Ne Width
    _ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg Bool
    is32Bit Cond
    NE  CmmExpr
    x CmmExpr
    y
          MO_F_Gt Width
    _ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg Bool
    is32Bit Cond
    GTT CmmExpr
    x CmmExpr
    y
          MO_F_Ge Width
    _ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg Bool
    is32Bit Cond
    GE  CmmExpr
    x CmmExpr
    y
          -- Invert comparison condition and swap operands
          -- See Note [SSE Parity Checks]
          MO_F_Lt Width
    _ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg Bool
    is32Bit Cond
    GTT  CmmExpr
    y CmmExpr
    x
          MO_F_Le Width
    _ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg Bool
    is32Bit Cond
    GE   CmmExpr
    y CmmExpr
    x

          MO_Eq Width
    _   -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condIntReg Cond
    EQQ CmmExpr
    x CmmExpr
    y
          MO_Ne Width
    _   -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condIntReg Cond
    NE  CmmExpr
    x CmmExpr
    y

          MO_S_Gt Width
    _ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condIntReg Cond
    GTT CmmExpr
    x CmmExpr
    y
          MO_S_Ge Width
    _ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condIntReg Cond
    GE  CmmExpr
    x CmmExpr
    y
          MO_S_Lt Width
    _ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condIntReg Cond
    LTT CmmExpr
    x CmmExpr
    y
          MO_S_Le Width
    _ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condIntReg Cond
    LE  CmmExpr
    x CmmExpr
    y

          MO_U_Gt Width
    _ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condIntReg Cond
    GU  CmmExpr
    x CmmExpr
    y
          MO_U_Ge Width
    _ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condIntReg Cond
    GEU CmmExpr
    x CmmExpr
    y
          MO_U_Lt Width
    _ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condIntReg Cond
    LU  CmmExpr
    x CmmExpr
    y
          MO_U_Le Width
    _ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condIntReg Cond
    LEU CmmExpr
    x CmmExpr
    y

          MO_F_Add Width
    w   -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialFCode_sse2 Width
    w Format -> Operand -> Operand -> Instr
    ADD  CmmExpr
    x CmmExpr
    y

          MO_F_Sub Width
    w   -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialFCode_sse2 Width
    w Format -> Operand -> Operand -> Instr
    SUB  CmmExpr
    x CmmExpr
    y

          MO_F_Quot Width
    w  -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialFCode_sse2 Width
    w Format -> Operand -> Operand -> Instr
    FDIV CmmExpr
    x CmmExpr
    y

          MO_F_Mul Width
    w   -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialFCode_sse2 Width
    w Format -> Operand -> Operand -> Instr
    MUL CmmExpr
    x CmmExpr
    y

          MO_Add Width
    rep -> Width -> CmmExpr -> CmmExpr -> NatM Register
    add_code Width
    rep CmmExpr
    x CmmExpr
    y
          MO_Sub Width
    rep -> Width -> CmmExpr -> CmmExpr -> NatM Register
    sub_code Width
    rep CmmExpr
    x CmmExpr
    y

          MO_S_Quot Width
    rep -> Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    div_code Width
    rep Bool
    True  Bool
    True  CmmExpr
    x CmmExpr
    y
          MO_S_Rem  Width
    rep -> Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    div_code Width
    rep Bool
    True  Bool
    False CmmExpr
    x CmmExpr
    y
          MO_U_Quot Width
    rep -> Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    div_code Width
    rep Bool
    False Bool
    True  CmmExpr
    x CmmExpr
    y
          MO_U_Rem  Width
    rep -> Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    div_code Width
    rep Bool
    False Bool
    False CmmExpr
    x CmmExpr
    y

          MO_S_MulMayOflo Width
    rep -> Width -> CmmExpr -> CmmExpr -> NatM Register
    imulMayOflo Width
    rep CmmExpr
    x CmmExpr
    y

          MO_Mul Width
    W8  -> CmmExpr -> CmmExpr -> NatM Register
    imulW8 CmmExpr
    x CmmExpr
    y
          MO_Mul Width
    rep -> Width -> (Format -> Operand -> Operand -> Instr) -> NatM Register
    triv_op Width
    rep Format -> Operand -> Operand -> Instr
    IMUL
          MO_And Width
    rep -> Width -> (Format -> Operand -> Operand -> Instr) -> NatM Register
    triv_op Width
    rep Format -> Operand -> Operand -> Instr
    AND
          MO_Or  Width
    rep -> Width -> (Format -> Operand -> Operand -> Instr) -> NatM Register
    triv_op Width
    rep Format -> Operand -> Operand -> Instr
    OR
          MO_Xor Width
    rep -> Width -> (Format -> Operand -> Operand -> Instr) -> NatM Register
    triv_op Width
    rep Format -> Operand -> Operand -> Instr
    XOR

            {- Shift ops on x86s have constraints on their source, it
               either has to be Imm, CL or 1
                => trivialCode is not restrictive enough (sigh.)
            -}
          MO_Shl Width
    rep   -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    shift_code Width
    rep Format -> Operand -> Operand -> Instr
    SHL CmmExpr
    x CmmExpr
    y {-False-}
          MO_U_Shr Width
    rep -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    shift_code Width
    rep Format -> Operand -> Operand -> Instr
    SHR CmmExpr
    x CmmExpr
    y {-False-}
          MO_S_Shr Width
    rep -> Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    shift_code Width
    rep Format -> Operand -> Operand -> Instr
    SAR CmmExpr
    x CmmExpr
    y {-False-}

          MO_V_Insert {}   -> NatM Register
    forall a. NatM a
    needLlvm
          MO_V_Extract {}  -> NatM Register
    forall a. NatM a
    needLlvm
          MO_V_Add {}      -> NatM Register
    forall a. NatM a
    needLlvm
          MO_V_Sub {}      -> NatM Register
    forall a. NatM a
    needLlvm
          MO_V_Mul {}      -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VS_Quot {}    -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VS_Rem {}     -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VS_Neg {}     -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VF_Insert {}  -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VF_Extract {} -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VF_Add {}     -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VF_Sub {}     -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VF_Mul {}     -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VF_Quot {}    -> NatM Register
    forall a. NatM a
    needLlvm
          MO_VF_Neg {}     -> NatM Register
    forall a. NatM a
    needLlvm

          MachOp
    _other -> String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister(x86) - binary CmmMachOp (1)" (MachOp -> SDoc
    pprMachOp MachOp
    mop)
      where
        --------------------
        triv_op :: Width -> (Format -> Operand -> Operand -> Instr) -> NatM Register
    triv_op Width
    width Format -> Operand -> Operand -> Instr
    instr = Width
    -> (Operand -> Operand -> Instr)
    -> Maybe (Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    width Operand -> Operand -> Instr
    op ((Operand -> Operand -> Instr)
    -> Maybe (Operand -> Operand -> Instr)
    forall a. a -> Maybe a
    Just Operand -> Operand -> Instr
    op) CmmExpr
    x CmmExpr
    y
                            where op :: Operand -> Operand -> Instr
    op   = Format -> Operand -> Operand -> Instr
    instr (Width -> Format
    intFormat Width
    width)

        -- Special case for IMUL for bytes, since the result of IMULB will be in
        -- %ax, the split to %dx/%edx/%rdx and %ax/%eax/%rax happens only for wider
        -- values.
        imulW8 :: CmmExpr -> CmmExpr -> NatM Register
        imulW8 :: CmmExpr -> CmmExpr -> NatM Register
    imulW8 CmmExpr
    arg_a CmmExpr
    arg_b = do
            (Reg
    a_reg, OrdList Instr
    a_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getNonClobberedReg CmmExpr
    arg_a
            Reg -> OrdList Instr
    b_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    arg_b

            let code :: OrdList Instr
    code = OrdList Instr
    a_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> OrdList Instr
    b_code Reg
    eax OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                       [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Format -> Operand -> Instr
    IMUL2 Format
    format (Reg -> Operand
    OpReg Reg
    a_reg) ]
                format :: Format
    format = Width -> Format
    intFormat Width
    W8

            Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> Reg -> OrdList Instr -> Register
    Fixed Format
    format Reg
    eax OrdList Instr
    code)

        imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
        imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
    imulMayOflo Width
    rep CmmExpr
    a CmmExpr
    b = do
             (Reg
    a_reg, OrdList Instr
    a_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getNonClobberedReg CmmExpr
    a
             Reg -> OrdList Instr
    b_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    b
             let
                 shift_amt :: Int
    shift_amt  = case Width
    rep of
                               Width
    W32 -> Int
    31
                               Width
    W64 -> Int
    63
                               Width
    _ -> String -> Int
    forall a. String -> a
    panic String
    "shift_amt"

                 format :: Format
    format = Width -> Format
    intFormat Width
    rep
                 code :: OrdList Instr
    code = OrdList Instr
    a_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> OrdList Instr
    b_code Reg
    eax OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                            [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                               Format -> Operand -> Instr
    IMUL2 Format
    format (Reg -> Operand
    OpReg Reg
    a_reg),   -- result in %edx:%eax
                               Format -> Operand -> Operand -> Instr
    SAR Format
    format (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    shift_amt)) (Reg -> Operand
    OpReg Reg
    eax),
                                    -- sign extend lower part
                               Format -> Operand -> Operand -> Instr
    SUB Format
    format (Reg -> Operand
    OpReg Reg
    edx) (Reg -> Operand
    OpReg Reg
    eax)
                                    -- compare against upper
                               -- eax==0 if high part == sign extended low part
                            ]
             Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> Reg -> OrdList Instr -> Register
    Fixed Format
    format Reg
    eax OrdList Instr
    code)

        --------------------
        shift_code :: Width
                   -> (Format -> Operand -> Operand -> Instr)
                   -> CmmExpr
                   -> CmmExpr
                   -> NatM Register

        {- Case1: shift length as immediate -}
        shift_code :: Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    shift_code Width
    width Format -> Operand -> Operand -> Instr
    instr CmmExpr
    x (CmmLit CmmLit
    lit)
          -- Handle the case of a shift larger than the width of the shifted value.
          -- This is necessary since x86 applies a mask of 0x1f to the shift
          -- amount, meaning that, e.g., `shr 47, $eax` will actually shift by
          -- `47 & 0x1f == 15`. See #20626.
          | CmmInt Integer
    n Width
    _ <- CmmLit
    lit
          , Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Width -> Int
    widthInBits Width
    width)
          = CmmExpr -> NatM Register
    getRegister (CmmExpr -> NatM Register) -> CmmExpr -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ CmmLit -> CmmExpr
    CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $ Integer -> Width -> CmmLit
    CmmInt Integer
    0 Width
    width

          | Bool
    otherwise = do
              Reg -> OrdList Instr
    x_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    x
              let
                   format :: Format
    format = Width -> Format
    intFormat Width
    width
                   code :: Reg -> OrdList Instr
    code Reg
    dst
                      = Reg -> OrdList Instr
    x_code Reg
    dst OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                        Format -> Operand -> Operand -> Instr
    instr Format
    format (Imm -> Operand
    OpImm (CmmLit -> Imm
    litToImm CmmLit
    lit)) (Reg -> Operand
    OpReg Reg
    dst)
              Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format Reg -> OrdList Instr
    code)

        {- Case2: shift length is complex (non-immediate)
          * y must go in %ecx.
          * we cannot do y first *and* put its result in %ecx, because
            %ecx might be clobbered by x.
          * if we do y second, then x cannot be
            in a clobbered reg.  Also, we cannot clobber x's reg
            with the instruction itself.
          * so we can either:
            - do y first, put its result in a fresh tmp, then copy it to %ecx later
            - do y second and put its result into %ecx.  x gets placed in a fresh
              tmp.  This is likely to be better, because the reg alloc can
              eliminate this reg->reg move here (it won't eliminate the other one,
              because the move is into the fixed %ecx).
          * in the case of C calls the use of ecx here can interfere with arguments.
            We avoid this with the hack described in Note [Evaluate C-call
            arguments before placing in destination registers]
        -}
        shift_code Width
    width Format -> Operand -> Operand -> Instr
    instr CmmExpr
    x CmmExpr
    y{-amount-} = do
            Reg -> OrdList Instr
    x_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    x
            let format :: Format
    format = Width -> Format
    intFormat Width
    width
            Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    format
            Reg -> OrdList Instr
    y_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    y
            let
               code :: OrdList Instr
    code = Reg -> OrdList Instr
    x_code Reg
    tmp OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                      Reg -> OrdList Instr
    y_code Reg
    ecx OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                      Format -> Operand -> Operand -> Instr
    instr Format
    format (Reg -> Operand
    OpReg Reg
    ecx) (Reg -> Operand
    OpReg Reg
    tmp)
            Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> Reg -> OrdList Instr -> Register
    Fixed Format
    format Reg
    tmp OrdList Instr
    code)

        --------------------
        add_code :: Width -> CmmExpr -> CmmExpr -> NatM Register
        add_code :: Width -> CmmExpr -> CmmExpr -> NatM Register
    add_code Width
    rep CmmExpr
    x (CmmLit (CmmInt Integer
    y Width
    _))
            | Integer -> Bool
    is32BitInteger Integer
    y
            , Width
    rep Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Width
    W8 -- LEA doesn't support byte size (#18614)
            = Width -> CmmExpr -> Integer -> NatM Register
    add_int Width
    rep CmmExpr
    x Integer
    y
        add_code Width
    rep CmmExpr
    x CmmExpr
    y = Width
    -> (Operand -> Operand -> Instr)
    -> Maybe (Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    rep (Format -> Operand -> Operand -> Instr
    ADD Format
    format) ((Operand -> Operand -> Instr)
    -> Maybe (Operand -> Operand -> Instr)
    forall a. a -> Maybe a
    Just (Format -> Operand -> Operand -> Instr
    ADD Format
    format)) CmmExpr
    x CmmExpr
    y
          where format :: Format
    format = Width -> Format
    intFormat Width
    rep
        -- TODO: There are other interesting patterns we want to replace
        --     with a LEA, e.g. `(x + offset) + (y << shift)`.

        --------------------
        sub_code :: Width -> CmmExpr -> CmmExpr -> NatM Register
        sub_code :: Width -> CmmExpr -> CmmExpr -> NatM Register
    sub_code Width
    rep CmmExpr
    x (CmmLit (CmmInt Integer
    y Width
    _))
            | Integer -> Bool
    is32BitInteger (-Integer
    y)
            , Width
    rep Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Width
    W8 -- LEA doesn't support byte size (#18614)
            = Width -> CmmExpr -> Integer -> NatM Register
    add_int Width
    rep CmmExpr
    x (-Integer
    y)
        sub_code Width
    rep CmmExpr
    x CmmExpr
    y = Width
    -> (Operand -> Operand -> Instr)
    -> Maybe (Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    rep (Format -> Operand -> Operand -> Instr
    SUB (Width -> Format
    intFormat Width
    rep)) Maybe (Operand -> Operand -> Instr)
    forall a. Maybe a
    Nothing CmmExpr
    x CmmExpr
    y

        -- our three-operand add instruction:
        add_int :: Width -> CmmExpr -> Integer -> NatM Register
    add_int Width
    width CmmExpr
    x Integer
    y = do
            (Reg
    x_reg, OrdList Instr
    x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
            let
                format :: Format
    format = Width -> Format
    intFormat Width
    width
                imm :: Imm
    imm = Int -> Imm
    ImmInt (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    y)
                code :: Reg -> OrdList Instr
    code Reg
    dst
                   = OrdList Instr
    x_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                     Format -> Operand -> Operand -> Instr
    LEA Format
    format
                            (AddrMode -> Operand
    OpAddr (EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex (Reg -> EABase
    EABaseReg Reg
    x_reg) EAIndex
    EAIndexNone Imm
    imm))
                            (Reg -> Operand
    OpReg Reg
    dst)
            --
            Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format Reg -> OrdList Instr
    code)

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

        -- See Note [DIV/IDIV for bytes]
        div_code :: Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    div_code Width
    W8 Bool
    signed Bool
    quotient CmmExpr
    x CmmExpr
    y = do
            let widen :: MachOp
    widen | Bool
    signed    = Width -> Width -> MachOp
    MO_SS_Conv Width
    W8 Width
    W16
                      | Bool
    otherwise = Width -> Width -> MachOp
    MO_UU_Conv Width
    W8 Width
    W16
            Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    div_code
                Width
    W16
                Bool
    signed
                Bool
    quotient
                (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp MachOp
    widen [CmmExpr
    x])
                (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp MachOp
    widen [CmmExpr
    y])

        div_code Width
    width Bool
    signed Bool
    quotient CmmExpr
    x CmmExpr
    y = do
               (Operand
    y_op, OrdList Instr
    y_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
    getRegOrMem CmmExpr
    y -- cannot be clobbered
               Reg -> OrdList Instr
    x_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    x
               let
                 format :: Format
    format = Width -> Format
    intFormat Width
    width
                 widen :: Instr
    widen | Bool
    signed    = Format -> Instr
    CLTD Format
    format
                       | Bool
    otherwise = Format -> Operand -> Operand -> Instr
    XOR Format
    format (Reg -> Operand
    OpReg Reg
    edx) (Reg -> Operand
    OpReg Reg
    edx)

                 instr :: Format -> Operand -> Instr
    instr | Bool
    signed    = Format -> Operand -> Instr
    IDIV
                       | Bool
    otherwise = Format -> Operand -> Instr
    DIV

                 code :: OrdList Instr
    code = OrdList Instr
    y_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                        Reg -> OrdList Instr
    x_code Reg
    eax OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                        [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [Instr
    widen, Format -> Operand -> Instr
    instr Format
    format Operand
    y_op]

                 result :: Reg
    result | Bool
    quotient  = Reg
    eax
                        | Bool
    otherwise = Reg
    edx

               Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> Reg -> OrdList Instr -> Register
    Fixed Format
    format Reg
    result OrdList Instr
    code)

    getRegister' Platform
    _ Bool
    _ (CmmLoad CmmExpr
    mem CmmType
    pk AlignmentSpec
    _)
      | CmmType -> Bool
    isFloatType CmmType
    pk
      = do
        Amode AddrMode
    addr OrdList Instr
    mem_code <- CmmExpr -> NatM Amode
    getAmode CmmExpr
    mem
        Width -> AddrMode -> OrdList Instr -> NatM Register
    loadFloatAmode  (CmmType -> Width
    typeWidth CmmType
    pk) AddrMode
    addr OrdList Instr
    mem_code

    getRegister' Platform
    _ Bool
    is32Bit (CmmLoad CmmExpr
    mem CmmType
    pk AlignmentSpec
    _)
      | Bool
    is32Bit Bool -> Bool -> Bool
    && Bool -> Bool
    not (CmmType -> Bool
    isWord64 CmmType
    pk)
      = do
        Reg -> OrdList Instr
    code <- (Operand -> Operand -> Instr)
    -> CmmExpr -> NatM (Reg -> OrdList Instr)
    intLoadCode Operand -> Operand -> Instr
    instr CmmExpr
    mem
        Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format Reg -> OrdList Instr
    code)
      where
        width :: Width
    width = CmmType -> Width
    typeWidth CmmType
    pk
        format :: Format
    format = Width -> Format
    intFormat Width
    width
        instr :: Operand -> Operand -> Instr
    instr = case Width
    width of
                    Width
    W8     -> Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II8
                    Width
    _other -> Format -> Operand -> Operand -> Instr
    MOV Format
    format
            -- We always zero-extend 8-bit loads, if we
            -- can't think of anything better.  This is because
            -- we can't guarantee access to an 8-bit variant of every register
            -- (esi and edi don't have 8-bit variants), so to make things
            -- simpler we do our 8-bit arithmetic with full 32-bit registers.

    -- Simpler memory load code on x86_64
    getRegister' Platform
    _ Bool
    is32Bit (CmmLoad CmmExpr
    mem CmmType
    pk AlignmentSpec
    _)
     | Bool -> Bool
    not Bool
    is32Bit
      = do
        Reg -> OrdList Instr
    code <- (Operand -> Operand -> Instr)
    -> CmmExpr -> NatM (Reg -> OrdList Instr)
    intLoadCode (Format -> Operand -> Operand -> Instr
    MOV Format
    format) CmmExpr
    mem
        Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format Reg -> OrdList Instr
    code)
      where format :: Format
    format = Width -> Format
    intFormat (Width -> Format) -> Width -> Format
    forall a b. (a -> b) -> a -> b
    $ CmmType -> Width
    typeWidth CmmType
    pk

    getRegister' Platform
    _ Bool
    is32Bit (CmmLit (CmmInt Integer
    0 Width
    width))
      = let
            format :: Format
    format = Width -> Format
    intFormat Width
    width

            -- x86_64: 32-bit xor is one byte shorter, and zero-extends to 64 bits
            format1 :: Format
    format1 = if Bool
    is32Bit then Format
    format
                               else case Format
    format of
                                    Format
    II64 -> Format
    II32
                                    Format
    _ -> Format
    format
            code :: Reg -> OrdList Instr
    code Reg
    dst
               = Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    XOR Format
    format1 (Reg -> Operand
    OpReg Reg
    dst) (Reg -> Operand
    OpReg Reg
    dst))
        in
            Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format Reg -> OrdList Instr
    code)

    -- Handle symbol references with LEA and %rip-relative addressing.
    -- See Note [%rip-relative addressing on x86-64].
    getRegister' Platform
    platform Bool
    is32Bit (CmmLit CmmLit
    lit)
      | CmmLit -> Bool
    is_label CmmLit
    lit
      , Bool -> Bool
    not Bool
    is32Bit
      = do let format :: Format
    format = CmmType -> Format
    cmmTypeFormat (Platform -> CmmLit -> CmmType
    cmmLitType Platform
    platform CmmLit
    lit)
               imm :: Imm
    imm = CmmLit -> Imm
    litToImm CmmLit
    lit
               op :: Operand
    op = AddrMode -> Operand
    OpAddr (EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex EABase
    EABaseRip EAIndex
    EAIndexNone Imm
    imm)
               code :: Reg -> OrdList Instr
    code Reg
    dst = Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    LEA Format
    format Operand
    op (Reg -> Operand
    OpReg Reg
    dst))
           Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format Reg -> OrdList Instr
    code)
      where
        is_label :: CmmLit -> Bool
    is_label (CmmLabel {})        = Bool
    True
        is_label (CmmLabelOff {})     = Bool
    True
        is_label (CmmLabelDiffOff {}) = Bool
    True
        is_label CmmLit
    _                    = Bool
    False

      -- optimisation for loading small literals on x86_64: take advantage
      -- of the automatic zero-extension from 32 to 64 bits, because the 32-bit
      -- instruction forms are shorter.
    getRegister' Platform
    platform Bool
    is32Bit (CmmLit CmmLit
    lit)
      | Bool -> Bool
    not Bool
    is32Bit, CmmType -> Bool
    isWord64 (Platform -> CmmLit -> CmmType
    cmmLitType Platform
    platform CmmLit
    lit), Bool -> Bool
    not (CmmLit -> Bool
    isBigLit CmmLit
    lit)
      = let
            imm :: Imm
    imm = CmmLit -> Imm
    litToImm CmmLit
    lit
            code :: Reg -> OrdList Instr
    code Reg
    dst = Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Imm -> Operand
    OpImm Imm
    imm) (Reg -> Operand
    OpReg Reg
    dst))
        in
            Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II64 Reg -> OrdList Instr
    code)
      where
       isBigLit :: CmmLit -> Bool
    isBigLit (CmmInt Integer
    i Width
    _) = Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0 Bool -> Bool -> Bool
    || Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    0xffffffff
       isBigLit CmmLit
    _ = Bool
    False
            -- note1: not the same as (not.is32BitLit), because that checks for
            -- signed literals that fit in 32 bits, but we want unsigned
            -- literals here.
            -- note2: all labels are small, because we're assuming the
            -- small memory model. See Note [%rip-relative addressing on x86-64].

    getRegister' Platform
    platform Bool
    _ (CmmLit CmmLit
    lit)
      = do let format :: Format
    format = CmmType -> Format
    cmmTypeFormat (Platform -> CmmLit -> CmmType
    cmmLitType Platform
    platform CmmLit
    lit)
               imm :: Imm
    imm = CmmLit -> Imm
    litToImm CmmLit
    lit
               code :: Reg -> OrdList Instr
    code Reg
    dst = Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV Format
    format (Imm -> Operand
    OpImm Imm
    imm) (Reg -> Operand
    OpReg Reg
    dst))
           Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format Reg -> OrdList Instr
    code)

    getRegister' Platform
    platform Bool
    _ CmmExpr
    other
        | CmmExpr -> Bool
    isVecExpr CmmExpr
    other  = NatM Register
    forall a. NatM a
    needLlvm
        | Bool
    otherwise        = String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister(x86)" (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    other)

    intLoadCode :: (Operand -> Operand -> Instr) -> CmmExpr
       -> NatM (Reg -> InstrBlock)
    intLoadCode :: (Operand -> Operand -> Instr)
    -> CmmExpr -> NatM (Reg -> OrdList Instr)
    intLoadCode Operand -> Operand -> Instr
    instr CmmExpr
    mem = do
      Amode AddrMode
    src OrdList Instr
    mem_code <- CmmExpr -> NatM Amode
    getAmode CmmExpr
    mem
      (Reg -> OrdList Instr) -> NatM (Reg -> OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (\Reg
    dst -> OrdList Instr
    mem_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Operand -> Operand -> Instr
    instr (AddrMode -> Operand
    OpAddr AddrMode
    src) (Reg -> Operand
    OpReg Reg
    dst))

    -- Compute an expression into *any* register, adding the appropriate
    -- move instruction if necessary.
    getAnyReg :: CmmExpr -> NatM (Reg -> InstrBlock)
    getAnyReg :: CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    expr = do
      Register
    r <- CmmExpr -> NatM Register
    getRegister CmmExpr
    expr
      Register -> NatM (Reg -> OrdList Instr)
    anyReg Register
    r

    anyReg :: Register -> NatM (Reg -> InstrBlock)
    anyReg :: Register -> NatM (Reg -> OrdList Instr)
    anyReg (Any Format
    _ Reg -> OrdList Instr
    code)          = (Reg -> OrdList Instr) -> NatM (Reg -> OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Reg -> OrdList Instr
    code
    anyReg (Fixed Format
    rep Reg
    reg OrdList Instr
    fcode) = (Reg -> OrdList Instr) -> NatM (Reg -> OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (\Reg
    dst -> OrdList Instr
    fcode OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> Reg -> Instr
    reg2reg Format
    rep Reg
    reg Reg
    dst)

    -- A bit like getSomeReg, but we want a reg that can be byte-addressed.
    -- Fixed registers might not be byte-addressable, so we make sure we've
    -- got a temporary, inserting an extra reg copy if necessary.
    getByteReg :: CmmExpr -> NatM (Reg, InstrBlock)
    getByteReg :: CmmExpr -> NatM (Reg, OrdList Instr)
    getByteReg CmmExpr
    expr = do
      Bool
    is32Bit <- NatM Bool
    is32BitPlatform
      if Bool
    is32Bit
          then do Register
    r <- CmmExpr -> NatM Register
    getRegister CmmExpr
    expr
                  case Register
    r of
                    Any Format
    rep Reg -> OrdList Instr
    code -> do
                        Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    rep
                        (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    tmp, Reg -> OrdList Instr
    code Reg
    tmp)
                    Fixed Format
    rep Reg
    reg OrdList Instr
    code
                        | Reg -> Bool
    isVirtualReg Reg
    reg -> (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    reg,OrdList Instr
    code)
                        | Bool
    otherwise -> do
                            Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    rep
                            (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    tmp, OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> Reg -> Instr
    reg2reg Format
    rep Reg
    reg Reg
    tmp)
                        -- ToDo: could optimise slightly by checking for
                        -- byte-addressable real registers, but that will
                        -- happen very rarely if at all.
          else CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    expr -- all regs are byte-addressable on x86_64

    -- Another variant: this time we want the result in a register that cannot
    -- be modified by code to evaluate an arbitrary expression.
    getNonClobberedReg :: CmmExpr -> NatM (Reg, InstrBlock)
    getNonClobberedReg :: CmmExpr -> NatM (Reg, OrdList Instr)
    getNonClobberedReg CmmExpr
    expr = do
      Register
    r <- CmmExpr -> NatM Register
    getRegister CmmExpr
    expr
      Platform
    platform <- NCGConfig -> Platform
    ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NatM NCGConfig
    getConfig
      case Register
    r of
        Any Format
    rep Reg -> OrdList Instr
    code -> do
            Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    rep
            (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    tmp, Reg -> OrdList Instr
    code Reg
    tmp)
        Fixed Format
    rep Reg
    reg OrdList Instr
    code
            -- only certain regs can be clobbered
            | Reg
    reg Reg -> [Reg] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` Platform -> [Reg]
    instrClobberedRegs Platform
    platform
            -> do
                    Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    rep
                    (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    tmp, OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> Reg -> Instr
    reg2reg Format
    rep Reg
    reg Reg
    tmp)
            | Bool
    otherwise ->
                    (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    reg, OrdList Instr
    code)

    reg2reg :: Format -> Reg -> Reg -> Instr
    reg2reg :: Format -> Reg -> Reg -> Instr
    reg2reg Format
    format Reg
    src Reg
    dst = Format -> Operand -> Operand -> Instr
    MOV Format
    format (Reg -> Operand
    OpReg Reg
    src) (Reg -> Operand
    OpReg Reg
    dst)

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

    -- | Convert a 'CmmExpr' representing a memory address into an 'Amode'.
    --
    -- An 'Amode' is a datatype representing a valid address form for the target
    -- (e.g. "Base + Index + disp" or immediate) and the code to compute it.
    getAmode :: CmmExpr -> NatM Amode
    getAmode :: CmmExpr -> NatM Amode
    getAmode CmmExpr
    e = do
       Platform
    platform <- NatM Platform
    getPlatform
       let is32Bit :: Bool
    is32Bit = Platform -> Bool
    target32Bit Platform
    platform

       case CmmExpr
    e of
          CmmRegOff CmmReg
    r Int
    n
             -> CmmExpr -> NatM Amode
    getAmode (CmmExpr -> NatM Amode) -> CmmExpr -> NatM Amode
    forall a b. (a -> b) -> a -> b
    $ Platform -> CmmReg -> Int -> CmmExpr
    mangleIndexTree Platform
    platform CmmReg
    r Int
    n

          CmmMachOp (MO_Add Width
    W64) [CmmReg (CmmGlobal GlobalReg
    PicBaseReg), CmmLit CmmLit
    displacement]
             | Bool -> Bool
    not Bool
    is32Bit
             -> Amode -> NatM Amode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Amode -> NatM Amode) -> Amode -> NatM Amode
    forall a b. (a -> b) -> a -> b
    $ AddrMode -> OrdList Instr -> Amode
    Amode (Imm -> AddrMode
    ripRel (CmmLit -> Imm
    litToImm CmmLit
    displacement)) OrdList Instr
    forall a. OrdList a
    nilOL

          -- This is all just ridiculous, since it carefully undoes
          -- what mangleIndexTree has just done.
          CmmMachOp (MO_Sub Width
    _rep) [CmmExpr
    x, CmmLit lit :: CmmLit
    lit@(CmmInt Integer
    i Width
    _)]
             | Platform -> CmmLit -> Bool
    is32BitLit Platform
    platform CmmLit
    lit
             -- assert (rep == II32)???
             -> do
                (Reg
    x_reg, OrdList Instr
    x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
                let off :: Imm
    off = Int -> Imm
    ImmInt (-(Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    i))
                Amode -> NatM Amode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode -> OrdList Instr -> Amode
    Amode (EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex (Reg -> EABase
    EABaseReg Reg
    x_reg) EAIndex
    EAIndexNone Imm
    off) OrdList Instr
    x_code)

          CmmMachOp (MO_Add Width
    _rep) [CmmExpr
    x, CmmLit CmmLit
    lit]
             | Platform -> CmmLit -> Bool
    is32BitLit Platform
    platform CmmLit
    lit
             -- assert (rep == II32)???
             -> do
                (Reg
    x_reg, OrdList Instr
    x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
                let off :: Imm
    off = CmmLit -> Imm
    litToImm CmmLit
    lit
                Amode -> NatM Amode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode -> OrdList Instr -> Amode
    Amode (EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex (Reg -> EABase
    EABaseReg Reg
    x_reg) EAIndex
    EAIndexNone Imm
    off) OrdList Instr
    x_code)

          -- Turn (lit1 << n  + lit2) into  (lit2 + lit1 << n) so it will be
          -- recognised by the next rule.
          CmmMachOp (MO_Add Width
    rep) [a :: CmmExpr
    a@(CmmMachOp (MO_Shl Width
    _) [CmmExpr]
    _), b :: CmmExpr
    b@(CmmLit CmmLit
    _)]
             -> CmmExpr -> NatM Amode
    getAmode (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_Add Width
    rep) [CmmExpr
    b,CmmExpr
    a])

          -- Matches: (x + offset) + (y << shift)
          CmmMachOp (MO_Add Width
    _) [CmmRegOff CmmReg
    x Int
    offset, CmmMachOp (MO_Shl Width
    _) [CmmExpr
    y, CmmLit (CmmInt Integer
    shift Width
    _)]]
             | Integer
    shift Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    0 Bool -> Bool -> Bool
    || Integer
    shift Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    1 Bool -> Bool -> Bool
    || Integer
    shift Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    2 Bool -> Bool -> Bool
    || Integer
    shift Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    3
             -> CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
    x86_complex_amode (CmmReg -> CmmExpr
    CmmReg CmmReg
    x) CmmExpr
    y Integer
    shift (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    offset)

          CmmMachOp (MO_Add Width
    _) [CmmExpr
    x, CmmMachOp (MO_Shl Width
    _) [CmmExpr
    y, CmmLit (CmmInt Integer
    shift Width
    _)]]
             | Integer
    shift Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    0 Bool -> Bool -> Bool
    || Integer
    shift Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    1 Bool -> Bool -> Bool
    || Integer
    shift Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    2 Bool -> Bool -> Bool
    || Integer
    shift Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    3
             -> CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
    x86_complex_amode CmmExpr
    x CmmExpr
    y Integer
    shift Integer
    0

          CmmMachOp (MO_Add Width
    _) [CmmExpr
    x, CmmMachOp (MO_Add Width
    _) [CmmMachOp (MO_Shl Width
    _)
                                                        [CmmExpr
    y, CmmLit (CmmInt Integer
    shift Width
    _)], CmmLit (CmmInt Integer
    offset Width
    _)]]
             | Integer
    shift Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    0 Bool -> Bool -> Bool
    || Integer
    shift Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    1 Bool -> Bool -> Bool
    || Integer
    shift Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    2 Bool -> Bool -> Bool
    || Integer
    shift Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    3
             Bool -> Bool -> Bool
    && Integer -> Bool
    is32BitInteger Integer
    offset
             -> CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
    x86_complex_amode CmmExpr
    x CmmExpr
    y Integer
    shift Integer
    offset

          CmmMachOp (MO_Add Width
    _) [CmmExpr
    x,CmmExpr
    y]
             | Bool -> Bool
    not (CmmExpr -> Bool
    isLit CmmExpr
    y) -- we already handle valid literals above.
             -> CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
    x86_complex_amode CmmExpr
    x CmmExpr
    y Integer
    0 Integer
    0

          -- Handle labels with %rip-relative addressing since in general the image
          -- may be loaded anywhere in the 64-bit address space (e.g. on Windows
          -- with high-entropy ASLR). See Note [%rip-relative addressing on x86-64].
          CmmLit CmmLit
    lit
             | Bool -> Bool
    not Bool
    is32Bit
             , CmmLit -> Bool
    is_label CmmLit
    lit
             -> Amode -> NatM Amode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode -> OrdList Instr -> Amode
    Amode (EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex EABase
    EABaseRip EAIndex
    EAIndexNone (CmmLit -> Imm
    litToImm CmmLit
    lit)) OrdList Instr
    forall a. OrdList a
    nilOL)

          CmmLit CmmLit
    lit
             | Platform -> CmmLit -> Bool
    is32BitLit Platform
    platform CmmLit
    lit
             -> Amode -> NatM Amode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode -> OrdList Instr -> Amode
    Amode (Imm -> Int -> AddrMode
    ImmAddr (CmmLit -> Imm
    litToImm CmmLit
    lit) Int
    0) OrdList Instr
    forall a. OrdList a
    nilOL)

          -- Literal with offsets too big (> 32 bits) fails during the linking phase
          -- (#15570). We already handled valid literals above so we don't have to
          -- test anything here.
          CmmLit (CmmLabelOff CLabel
    l Int
    off)
             -> CmmExpr -> NatM Amode
    getAmode (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_Add Width
    W64) [ CmmLit -> CmmExpr
    CmmLit (CLabel -> CmmLit
    CmmLabel CLabel
    l)
                                                 , CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    off) Width
    W64)
                                                 ])
          CmmLit (CmmLabelDiffOff CLabel
    l1 CLabel
    l2 Int
    off Width
    w)
             -> CmmExpr -> NatM Amode
    getAmode (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_Add Width
    W64) [ CmmLit -> CmmExpr
    CmmLit (CLabel -> CLabel -> Int -> Width -> CmmLit
    CmmLabelDiffOff CLabel
    l1 CLabel
    l2 Int
    0 Width
    w)
                                                 , CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    off) Width
    W64)
                                                 ])

          -- in case we can't do something better, we just compute the expression
          -- and put the result in a register
          CmmExpr
    _ -> do
            (Reg
    reg,OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    e
            Amode -> NatM Amode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode -> OrdList Instr -> Amode
    Amode (EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex (Reg -> EABase
    EABaseReg Reg
    reg) EAIndex
    EAIndexNone (Int -> Imm
    ImmInt Int
    0)) OrdList Instr
    code)
      where
        is_label :: CmmLit -> Bool
    is_label (CmmLabel{}) = Bool
    True
        is_label (CmmLabelOff{}) = Bool
    True
        is_label (CmmLabelDiffOff{}) = Bool
    True
        is_label CmmLit
    _ = Bool
    False

    -- | Like 'getAmode', but on 32-bit use simple register addressing
    -- (i.e. no index register). This stops us from running out of
    -- registers on x86 when using instructions such as cmpxchg, which can
    -- use up to three virtual registers and one fixed register.
    getSimpleAmode :: CmmExpr -> NatM Amode
    getSimpleAmode :: CmmExpr -> NatM Amode
    getSimpleAmode CmmExpr
    addr = NatM Bool
    is32BitPlatform NatM Bool -> (Bool -> NatM Amode) -> NatM Amode
    forall a b. NatM a -> (a -> NatM b) -> NatM b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
      Bool
    False -> CmmExpr -> NatM Amode
    getAmode CmmExpr
    addr
      Bool
    True  -> do
        Reg -> OrdList Instr
    addr_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    addr
        NCGConfig
    config <- NatM NCGConfig
    getConfig
        Reg
    addr_r <- Format -> NatM Reg
    getNewRegNat (Width -> Format
    intFormat (NCGConfig -> Width
    ncgWordWidth NCGConfig
    config))
        let amode :: AddrMode
    amode = EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex (Reg -> EABase
    EABaseReg Reg
    addr_r) EAIndex
    EAIndexNone (Int -> Imm
    ImmInt Int
    0)
        Amode -> NatM Amode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Amode -> NatM Amode) -> Amode -> NatM Amode
    forall a b. (a -> b) -> a -> b
    $! AddrMode -> OrdList Instr -> Amode
    Amode AddrMode
    amode (Reg -> OrdList Instr
    addr_code Reg
    addr_r)

    x86_complex_amode :: CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
    x86_complex_amode :: CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
    x86_complex_amode CmmExpr
    base CmmExpr
    index Integer
    shift Integer
    offset
      = do (Reg
    x_reg, OrdList Instr
    x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getNonClobberedReg CmmExpr
    base
            -- x must be in a temp, because it has to stay live over y_code
            -- we could compare x_reg and y_reg and do something better here...
           (Reg
    y_reg, OrdList Instr
    y_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    index
           let
               code :: OrdList Instr
    code = OrdList Instr
    x_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    y_code
               base :: Int
    base = case Integer
    shift of Integer
    0 -> Int
    1; Integer
    1 -> Int
    2; Integer
    2 -> Int
    4; Integer
    3 -> Int
    8;
                                    Integer
    n -> String -> Int
    forall a. String -> a
    panic (String -> Int) -> String -> Int
    forall a b. (a -> b) -> a -> b
    $ String
    "x86_complex_amode: unhandled shift! (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
           Amode -> NatM Amode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode -> OrdList Instr -> Amode
    Amode (EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex (Reg -> EABase
    EABaseReg Reg
    x_reg) (Reg -> Int -> EAIndex
    EAIndex Reg
    y_reg Int
    base) (Int -> Imm
    ImmInt (Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    offset)))
                   OrdList Instr
    code)

    -- -----------------------------------------------------------------------------
    -- getOperand: sometimes any operand will do.

    -- getNonClobberedOperand: the value of the operand will remain valid across
    -- the computation of an arbitrary expression, unless the expression
    -- is computed directly into a register which the operand refers to
    -- (see trivialCode where this function is used for an example).

    getNonClobberedOperand :: CmmExpr -> NatM (Operand, InstrBlock)
    getNonClobberedOperand :: CmmExpr -> NatM (Operand, OrdList Instr)
    getNonClobberedOperand (CmmLit CmmLit
    lit) =
      if CmmLit -> Bool
    isSuitableFloatingPointLit CmmLit
    lit
      then do
        let CmmFloat Rational
    _ Width
    w = CmmLit
    lit
        Amode AddrMode
    addr OrdList Instr
    code <- Alignment -> CmmLit -> NatM Amode
    memConstant (Int -> Alignment
    mkAlignment (Int -> Alignment) -> Int -> Alignment
    forall a b. (a -> b) -> a -> b
    $ Width -> Int
    widthInBytes Width
    w) CmmLit
    lit
        (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode -> Operand
    OpAddr AddrMode
    addr, OrdList Instr
    code)
      else do
        Platform
    platform <- NatM Platform
    getPlatform
        if Platform -> CmmLit -> Bool
    is32BitLit Platform
    platform CmmLit
    lit Bool -> Bool -> Bool
    && Bool -> Bool
    not (CmmType -> Bool
    isFloatType (Platform -> CmmLit -> CmmType
    cmmLitType Platform
    platform CmmLit
    lit))
        then (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Imm -> Operand
    OpImm (CmmLit -> Imm
    litToImm CmmLit
    lit), OrdList Instr
    forall a. OrdList a
    nilOL)
        else CmmExpr -> NatM (Operand, OrdList Instr)
    getNonClobberedOperand_generic (CmmLit -> CmmExpr
    CmmLit CmmLit
    lit)

    getNonClobberedOperand (CmmLoad CmmExpr
    mem CmmType
    pk AlignmentSpec
    _) = do
      Bool
    is32Bit <- NatM Bool
    is32BitPlatform
      -- this logic could be simplified
      -- TODO FIXME
      if   (if Bool
    is32Bit then Bool -> Bool
    not (CmmType -> Bool
    isWord64 CmmType
    pk) else Bool
    True)
          -- if 32bit and pk is at float/double/simd value
          -- or if 64bit
          --  this could use some eyeballs or i'll need to stare at it more later
        then do
          Platform
    platform <- NCGConfig -> Platform
    ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NatM NCGConfig
    getConfig
          Amode AddrMode
    src OrdList Instr
    mem_code <- CmmExpr -> NatM Amode
    getAmode CmmExpr
    mem
          (AddrMode
    src',OrdList Instr
    save_code) <-
            if (Platform -> AddrMode -> Bool
    amodeCouldBeClobbered Platform
    platform AddrMode
    src)
                    then do
                       Reg
    tmp <- Format -> NatM Reg
    getNewRegNat (Bool -> Format
    archWordFormat Bool
    is32Bit)
                       (AddrMode, OrdList Instr) -> NatM (AddrMode, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex (Reg -> EABase
    EABaseReg Reg
    tmp) EAIndex
    EAIndexNone (Int -> Imm
    ImmInt Int
    0),
                               Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    LEA (Bool -> Format
    archWordFormat Bool
    is32Bit)
                                           (AddrMode -> Operand
    OpAddr AddrMode
    src)
                                           (Reg -> Operand
    OpReg Reg
    tmp)))
                    else
                       (AddrMode, OrdList Instr) -> NatM (AddrMode, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode
    src, OrdList Instr
    forall a. OrdList a
    nilOL)
          (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode -> Operand
    OpAddr AddrMode
    src', OrdList Instr
    mem_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    save_code)
        else
          -- if its a word or gcptr on 32bit?
          CmmExpr -> NatM (Operand, OrdList Instr)
    getNonClobberedOperand_generic (CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
    CmmLoad CmmExpr
    mem CmmType
    pk AlignmentSpec
    NaturallyAligned)

    getNonClobberedOperand CmmExpr
    e = CmmExpr -> NatM (Operand, OrdList Instr)
    getNonClobberedOperand_generic CmmExpr
    e

    getNonClobberedOperand_generic :: CmmExpr -> NatM (Operand, InstrBlock)
    getNonClobberedOperand_generic :: CmmExpr -> NatM (Operand, OrdList Instr)
    getNonClobberedOperand_generic CmmExpr
    e = do
      (Reg
    reg, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getNonClobberedReg CmmExpr
    e
      (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg -> Operand
    OpReg Reg
    reg, OrdList Instr
    code)

    amodeCouldBeClobbered :: Platform -> AddrMode -> Bool
    amodeCouldBeClobbered :: Platform -> AddrMode -> Bool
    amodeCouldBeClobbered Platform
    platform AddrMode
    amode = (Reg -> Bool) -> [Reg] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Platform -> Reg -> Bool
    regClobbered Platform
    platform) (AddrMode -> [Reg]
    addrModeRegs AddrMode
    amode)

    regClobbered :: Platform -> Reg -> Bool
    regClobbered :: Platform -> Reg -> Bool
    regClobbered Platform
    platform (RegReal (RealRegSingle Int
    rr)) = Platform -> Int -> Bool
    freeReg Platform
    platform Int
    rr
    regClobbered Platform
    _ Reg
    _ = Bool
    False

    -- getOperand: the operand is not required to remain valid across the
    -- computation of an arbitrary expression.
    getOperand :: CmmExpr -> NatM (Operand, InstrBlock)

    getOperand :: CmmExpr -> NatM (Operand, OrdList Instr)
    getOperand (CmmLit CmmLit
    lit) = do
      Bool
    use_sse2 <- NatM Bool
    sse2Enabled
      if (Bool
    use_sse2 Bool -> Bool -> Bool
    && CmmLit -> Bool
    isSuitableFloatingPointLit CmmLit
    lit)
        then do
          let CmmFloat Rational
    _ Width
    w = CmmLit
    lit
          Amode AddrMode
    addr OrdList Instr
    code <- Alignment -> CmmLit -> NatM Amode
    memConstant (Int -> Alignment
    mkAlignment (Int -> Alignment) -> Int -> Alignment
    forall a b. (a -> b) -> a -> b
    $ Width -> Int
    widthInBytes Width
    w) CmmLit
    lit
          (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode -> Operand
    OpAddr AddrMode
    addr, OrdList Instr
    code)
        else do

      Platform
    platform <- NatM Platform
    getPlatform
      if Platform -> CmmLit -> Bool
    is32BitLit Platform
    platform CmmLit
    lit Bool -> Bool -> Bool
    && Bool -> Bool
    not (CmmType -> Bool
    isFloatType (Platform -> CmmLit -> CmmType
    cmmLitType Platform
    platform CmmLit
    lit))
        then (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Imm -> Operand
    OpImm (CmmLit -> Imm
    litToImm CmmLit
    lit), OrdList Instr
    forall a. OrdList a
    nilOL)
        else CmmExpr -> NatM (Operand, OrdList Instr)
    getOperand_generic (CmmLit -> CmmExpr
    CmmLit CmmLit
    lit)

    getOperand (CmmLoad CmmExpr
    mem CmmType
    pk AlignmentSpec
    _) = do
      Bool
    is32Bit <- NatM Bool
    is32BitPlatform
      Bool
    use_sse2 <- NatM Bool
    sse2Enabled
      if (Bool -> Bool
    not (CmmType -> Bool
    isFloatType CmmType
    pk) Bool -> Bool -> Bool
    || Bool
    use_sse2) Bool -> Bool -> Bool
    && (if Bool
    is32Bit then Bool -> Bool
    not (CmmType -> Bool
    isWord64 CmmType
    pk) else Bool
    True)
         then do
           Amode AddrMode
    src OrdList Instr
    mem_code <- CmmExpr -> NatM Amode
    getAmode CmmExpr
    mem
           (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode -> Operand
    OpAddr AddrMode
    src, OrdList Instr
    mem_code)
         else
           CmmExpr -> NatM (Operand, OrdList Instr)
    getOperand_generic (CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
    CmmLoad CmmExpr
    mem CmmType
    pk AlignmentSpec
    NaturallyAligned)

    getOperand CmmExpr
    e = CmmExpr -> NatM (Operand, OrdList Instr)
    getOperand_generic CmmExpr
    e

    getOperand_generic :: CmmExpr -> NatM (Operand, InstrBlock)
    getOperand_generic :: CmmExpr -> NatM (Operand, OrdList Instr)
    getOperand_generic CmmExpr
    e = do
        (Reg
    reg, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    e
        (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg -> Operand
    OpReg Reg
    reg, OrdList Instr
    code)

    isOperand :: Platform -> CmmExpr -> Bool
    isOperand :: Platform -> CmmExpr -> Bool
    isOperand Platform
    _ (CmmLoad CmmExpr
    _ CmmType
    _ AlignmentSpec
    _) = Bool
    True
    isOperand Platform
    platform (CmmLit CmmLit
    lit)
                              = Platform -> CmmLit -> Bool
    is32BitLit Platform
    platform CmmLit
    lit
                              Bool -> Bool -> Bool
    || CmmLit -> Bool
    isSuitableFloatingPointLit CmmLit
    lit
    isOperand Platform
    _ CmmExpr
    _            = Bool
    False

    -- | Given a 'Register', produce a new 'Register' with an instruction block
    -- which will check the value for alignment. Used for @-falignment-sanitisation@.
    addAlignmentCheck :: Int -> Register -> Register
    addAlignmentCheck :: Int -> Register -> Register
    addAlignmentCheck Int
    align Register
    reg =
        case Register
    reg of
          Fixed Format
    fmt Reg
    reg OrdList Instr
    code -> Format -> Reg -> OrdList Instr -> Register
    Fixed Format
    fmt Reg
    reg (OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Format -> Reg -> OrdList Instr
    check Format
    fmt Reg
    reg)
          Any Format
    fmt Reg -> OrdList Instr
    f          -> Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    fmt (\Reg
    reg -> Reg -> OrdList Instr
    f Reg
    reg OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Format -> Reg -> OrdList Instr
    check Format
    fmt Reg
    reg)
      where
        check :: Format -> Reg -> InstrBlock
        check :: Format -> Reg -> OrdList Instr
    check Format
    fmt Reg
    reg =
            Bool -> OrdList Instr -> OrdList Instr
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Format -> Bool
    isFloatFormat Format
    fmt) (OrdList Instr -> OrdList Instr) -> OrdList Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $
            [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Format -> Operand -> Operand -> Instr
    TEST Format
    fmt (Imm -> Operand
    OpImm (Imm -> Operand) -> Imm -> Operand
    forall a b. (a -> b) -> a -> b
    $ Int -> Imm
    ImmInt (Int -> Imm) -> Int -> Imm
    forall a b. (a -> b) -> a -> b
    $ Int
    alignInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) (Reg -> Operand
    OpReg Reg
    reg)
                 , Cond -> Imm -> Instr
    JXX_GBL Cond
    NE (Imm -> Instr) -> Imm -> Instr
    forall a b. (a -> b) -> a -> b
    $ CLabel -> Imm
    ImmCLbl CLabel
    mkBadAlignmentLabel
                 ]

    memConstant :: Alignment -> CmmLit -> NatM Amode
    memConstant :: Alignment -> CmmLit -> NatM Amode
    memConstant Alignment
    align CmmLit
    lit = do
      CLabel
    lbl <- NatM CLabel
    getNewLabelNat
      let rosection :: Section
    rosection = SectionType -> CLabel -> Section
    Section SectionType
    ReadOnlyData CLabel
    lbl
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      Platform
    platform <- NatM Platform
    getPlatform
      (AddrMode
    addr, OrdList Instr
    addr_code) <- if Platform -> Bool
    target32Bit Platform
    platform
                           then do CmmExpr
    dynRef <- NCGConfig -> ReferenceKind -> CLabel -> NatM CmmExpr
    forall (m :: * -> *).
    CmmMakeDynamicReferenceM m =>
    NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
    cmmMakeDynamicReference
                                                 NCGConfig
    config
                                                 ReferenceKind
    DataReference
                                                 CLabel
    lbl
                                   Amode AddrMode
    addr OrdList Instr
    addr_code <- CmmExpr -> NatM Amode
    getAmode CmmExpr
    dynRef
                                   (AddrMode, OrdList Instr) -> NatM (AddrMode, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode
    addr, OrdList Instr
    addr_code)
                           else (AddrMode, OrdList Instr) -> NatM (AddrMode, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Imm -> AddrMode
    ripRel (CLabel -> Imm
    ImmCLbl CLabel
    lbl), OrdList Instr
    forall a. OrdList a
    nilOL)
      let code :: OrdList Instr
    code =
            Section -> (Alignment, RawCmmStatics) -> Instr
    LDATA Section
    rosection (Alignment
    align, CLabel -> [CmmStatic] -> RawCmmStatics
    forall (rawOnly :: Bool).
    CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
    CmmStaticsRaw CLabel
    lbl [CmmLit -> CmmStatic
    CmmStaticLit CmmLit
    lit])
            Instr -> OrdList Instr -> OrdList Instr
    forall a. a -> OrdList a -> OrdList a
    `consOL` OrdList Instr
    addr_code
      Amode -> NatM Amode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode -> OrdList Instr -> Amode
    Amode AddrMode
    addr OrdList Instr
    code)

    loadFloatAmode :: Width -> AddrMode -> InstrBlock -> NatM Register
    loadFloatAmode :: Width -> AddrMode -> OrdList Instr -> NatM Register
    loadFloatAmode Width
    w AddrMode
    addr OrdList Instr
    addr_code = do
      let format :: Format
    format = Width -> Format
    floatFormat Width
    w
          code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                        Format -> Operand -> Operand -> Instr
    MOV Format
    format (AddrMode -> Operand
    OpAddr AddrMode
    addr) (Reg -> Operand
    OpReg Reg
    dst)

      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format Reg -> OrdList Instr
    code)

    -- if we want a floating-point literal as an operand, we can
    -- use it directly from memory.  However, if the literal is
    -- zero, we're better off generating it into a register using
    -- xor.
    isSuitableFloatingPointLit :: CmmLit -> Bool
    isSuitableFloatingPointLit :: CmmLit -> Bool
    isSuitableFloatingPointLit (CmmFloat Rational
    f Width
    _) = Rational
    f Rational -> Rational -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Rational
    0.0
    isSuitableFloatingPointLit CmmLit
    _ = Bool
    False

    getRegOrMem :: CmmExpr -> NatM (Operand, InstrBlock)
    getRegOrMem :: CmmExpr -> NatM (Operand, OrdList Instr)
    getRegOrMem e :: CmmExpr
    e@(CmmLoad CmmExpr
    mem CmmType
    pk AlignmentSpec
    _) = do
      Bool
    is32Bit <- NatM Bool
    is32BitPlatform
      Bool
    use_sse2 <- NatM Bool
    sse2Enabled
      if (Bool -> Bool
    not (CmmType -> Bool
    isFloatType CmmType
    pk) Bool -> Bool -> Bool
    || Bool
    use_sse2) Bool -> Bool -> Bool
    && (if Bool
    is32Bit then Bool -> Bool
    not (CmmType -> Bool
    isWord64 CmmType
    pk) else Bool
    True)
         then do
           Amode AddrMode
    src OrdList Instr
    mem_code <- CmmExpr -> NatM Amode
    getAmode CmmExpr
    mem
           (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode -> Operand
    OpAddr AddrMode
    src, OrdList Instr
    mem_code)
         else do
           (Reg
    reg, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getNonClobberedReg CmmExpr
    e
           (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg -> Operand
    OpReg Reg
    reg, OrdList Instr
    code)
    getRegOrMem CmmExpr
    e = do
        (Reg
    reg, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getNonClobberedReg CmmExpr
    e
        (Operand, OrdList Instr) -> NatM (Operand, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg -> Operand
    OpReg Reg
    reg, OrdList Instr
    code)

    is32BitLit :: Platform -> CmmLit -> Bool
    is32BitLit :: Platform -> CmmLit -> Bool
    is32BitLit Platform
    platform CmmLit
    _lit
       | Platform -> Bool
    target32Bit Platform
    platform = Bool
    True
    is32BitLit Platform
    platform CmmLit
    lit =
       case CmmLit
    lit of
          CmmInt Integer
    i Width
    W64              -> Integer -> Bool
    is32BitInteger Integer
    i
          -- Except on Windows, assume that labels are in the range 0-2^31-1: this
          -- assumes the small memory model. Note [%rip-relative addressing on
          -- x86-64].
          CmmLabel CLabel
    _                -> Bool
    low_image
          -- however we can't assume that label offsets are in this range
          -- (see #15570)
          CmmLabelOff CLabel
    _ Int
    off         -> Bool
    low_image Bool -> Bool -> Bool
    && Integer -> Bool
    is32BitInteger (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    off)
          CmmLabelDiffOff CLabel
    _ CLabel
    _ Int
    off Width
    _ -> Bool
    low_image Bool -> Bool -> Bool
    && Integer -> Bool
    is32BitInteger (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    off)
          CmmLit
    _                         -> Bool
    True
      where
        -- Is the executable image certain to be located below 4GB? As noted in
        -- Note [%rip-relative addressing on x86-64], this is not true on Windows.
        low_image :: Bool
    low_image =
          case Platform -> OS
    platformOS Platform
    platform of
            OS
    OSMinGW32 -> Bool
    False   -- See Note [%rip-relative addressing on x86-64]
            OS
    _         -> Bool
    True

    -- Set up a condition code for a conditional branch.

    getCondCode :: CmmExpr -> NatM CondCode

    -- yes, they really do seem to want exactly the same!

    getCondCode :: CmmExpr -> NatM CondCode
    getCondCode (CmmMachOp MachOp
    mop [CmmExpr
    x, CmmExpr
    y])
      =
        case MachOp
    mop of
          MO_F_Eq Width
    W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    EQQ CmmExpr
    x CmmExpr
    y
          MO_F_Ne Width
    W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    NE  CmmExpr
    x CmmExpr
    y
          MO_F_Gt Width
    W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    GTT CmmExpr
    x CmmExpr
    y
          MO_F_Ge Width
    W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    GE  CmmExpr
    x CmmExpr
    y
          -- Invert comparison condition and swap operands
          -- See Note [SSE Parity Checks]
          MO_F_Lt Width
    W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    GTT  CmmExpr
    y CmmExpr
    x
          MO_F_Le Width
    W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    GE   CmmExpr
    y CmmExpr
    x

          MO_F_Eq Width
    W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    EQQ CmmExpr
    x CmmExpr
    y
          MO_F_Ne Width
    W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    NE  CmmExpr
    x CmmExpr
    y
          MO_F_Gt Width
    W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    GTT CmmExpr
    x CmmExpr
    y
          MO_F_Ge Width
    W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    GE  CmmExpr
    x CmmExpr
    y
          MO_F_Lt Width
    W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    GTT CmmExpr
    y CmmExpr
    x
          MO_F_Le Width
    W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    GE  CmmExpr
    y CmmExpr
    x

          MachOp
    _ -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode (MachOp -> Cond
    machOpToCond MachOp
    mop) CmmExpr
    x CmmExpr
    y

    getCondCode CmmExpr
    other = do
       Platform
    platform <- NatM Platform
    getPlatform
       String -> SDoc -> NatM CondCode
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getCondCode(2)(x86,x86_64)" (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    other)

    machOpToCond :: MachOp -> Cond
    machOpToCond :: MachOp -> Cond
    machOpToCond MachOp
    mo = case MachOp
    mo of
      MO_Eq Width
    _   -> Cond
    EQQ
      MO_Ne Width
    _   -> Cond
    NE
      MO_S_Gt Width
    _ -> Cond
    GTT
      MO_S_Ge Width
    _ -> Cond
    GE
      MO_S_Lt Width
    _ -> Cond
    LTT
      MO_S_Le Width
    _ -> Cond
    LE
      MO_U_Gt Width
    _ -> Cond
    GU
      MO_U_Ge Width
    _ -> Cond
    GEU
      MO_U_Lt Width
    _ -> Cond
    LU
      MO_U_Le Width
    _ -> Cond
    LEU
      MachOp
    _other -> String -> SDoc -> Cond
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "machOpToCond" (MachOp -> SDoc
    pprMachOp MachOp
    mo)

    -- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be
    -- passed back up the tree.

    condIntCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode Cond
    cond CmmExpr
    x CmmExpr
    y = do Platform
    platform <- NatM Platform
    getPlatform
                              Platform -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode' Platform
    platform Cond
    cond CmmExpr
    x CmmExpr
    y

    condIntCode' :: Platform -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode

    -- memory vs immediate
    condIntCode' :: Platform -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode' Platform
    platform Cond
    cond (CmmLoad CmmExpr
    x CmmType
    pk AlignmentSpec
    _) (CmmLit CmmLit
    lit)
     | Platform -> CmmLit -> Bool
    is32BitLit Platform
    platform CmmLit
    lit = do
        Amode AddrMode
    x_addr OrdList Instr
    x_code <- CmmExpr -> NatM Amode
    getAmode CmmExpr
    x
        let
            imm :: Imm
    imm  = CmmLit -> Imm
    litToImm CmmLit
    lit
            code :: OrdList Instr
    code = OrdList Instr
    x_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                      Format -> Operand -> Operand -> Instr
    CMP (CmmType -> Format
    cmmTypeFormat CmmType
    pk) (Imm -> Operand
    OpImm Imm
    imm) (AddrMode -> Operand
    OpAddr AddrMode
    x_addr)
        --
        CondCode -> NatM CondCode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Cond -> OrdList Instr -> CondCode
    CondCode Bool
    False Cond
    cond OrdList Instr
    code)

    -- anything vs zero, using a mask
    -- TODO: Add some sanity checking!!!!
    condIntCode' Platform
    platform Cond
    cond (CmmMachOp (MO_And Width
    _) [CmmExpr
    x,CmmExpr
    o2]) (CmmLit (CmmInt Integer
    0 Width
    pk))
        | (CmmLit lit :: CmmLit
    lit@(CmmInt Integer
    mask Width
    _)) <- CmmExpr
    o2, Platform -> CmmLit -> Bool
    is32BitLit Platform
    platform CmmLit
    lit
        = do
          (Reg
    x_reg, OrdList Instr
    x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
          let
             code :: OrdList Instr
    code = OrdList Instr
    x_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                    Format -> Operand -> Operand -> Instr
    TEST (Width -> Format
    intFormat Width
    pk) (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    mask)) (Reg -> Operand
    OpReg Reg
    x_reg)
          --
          CondCode -> NatM CondCode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Cond -> OrdList Instr -> CondCode
    CondCode Bool
    False Cond
    cond OrdList Instr
    code)

    -- anything vs zero
    condIntCode' Platform
    _ Cond
    cond CmmExpr
    x (CmmLit (CmmInt Integer
    0 Width
    pk)) = do
        (Reg
    x_reg, OrdList Instr
    x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
        let
            code :: OrdList Instr
    code = OrdList Instr
    x_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                      Format -> Operand -> Operand -> Instr
    TEST (Width -> Format
    intFormat Width
    pk) (Reg -> Operand
    OpReg Reg
    x_reg) (Reg -> Operand
    OpReg Reg
    x_reg)
        --
        CondCode -> NatM CondCode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Cond -> OrdList Instr -> CondCode
    CondCode Bool
    False Cond
    cond OrdList Instr
    code)

    -- anything vs operand
    condIntCode' Platform
    platform Cond
    cond CmmExpr
    x CmmExpr
    y
     | Platform -> CmmExpr -> Bool
    isOperand Platform
    platform CmmExpr
    y = do
        (Reg
    x_reg, OrdList Instr
    x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getNonClobberedReg CmmExpr
    x
        (Operand
    y_op,  OrdList Instr
    y_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
    getOperand CmmExpr
    y
        let
            code :: OrdList Instr
    code = OrdList Instr
    x_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    y_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                      Format -> Operand -> Operand -> Instr
    CMP (CmmType -> Format
    cmmTypeFormat (Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    x)) Operand
    y_op (Reg -> Operand
    OpReg Reg
    x_reg)
        CondCode -> NatM CondCode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Cond -> OrdList Instr -> CondCode
    CondCode Bool
    False Cond
    cond OrdList Instr
    code)
    -- operand vs. anything: invert the comparison so that we can use a
    -- single comparison instruction.
     | Platform -> CmmExpr -> Bool
    isOperand Platform
    platform CmmExpr
    x
     , Just Cond
    revcond <- Cond -> Maybe Cond
    maybeFlipCond Cond
    cond = do
        (Reg
    y_reg, OrdList Instr
    y_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getNonClobberedReg CmmExpr
    y
        (Operand
    x_op,  OrdList Instr
    x_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
    getOperand CmmExpr
    x
        let
            code :: OrdList Instr
    code = OrdList Instr
    y_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    x_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                      Format -> Operand -> Operand -> Instr
    CMP (CmmType -> Format
    cmmTypeFormat (Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    x)) Operand
    x_op (Reg -> Operand
    OpReg Reg
    y_reg)
        CondCode -> NatM CondCode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Cond -> OrdList Instr -> CondCode
    CondCode Bool
    False Cond
    revcond OrdList Instr
    code)

    -- anything vs anything
    condIntCode' Platform
    platform Cond
    cond CmmExpr
    x CmmExpr
    y = do
      (Reg
    y_reg, OrdList Instr
    y_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getNonClobberedReg CmmExpr
    y
      (Operand
    x_op, OrdList Instr
    x_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
    getRegOrMem CmmExpr
    x
      let
            code :: OrdList Instr
    code = OrdList Instr
    y_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                   OrdList Instr
    x_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                      Format -> Operand -> Operand -> Instr
    CMP (CmmType -> Format
    cmmTypeFormat (Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    x)) (Reg -> Operand
    OpReg Reg
    y_reg) Operand
    x_op
      CondCode -> NatM CondCode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Cond -> OrdList Instr -> CondCode
    CondCode Bool
    False Cond
    cond OrdList Instr
    code)

    --------------------------------------------------------------------------------
    condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode

    condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    cond CmmExpr
    x CmmExpr
    y
      =  NatM CondCode
    condFltCode_sse2
      where

      -- in the SSE2 comparison ops (ucomiss, ucomisd) the left arg may be
      -- an operand, but the right must be a reg.  We can probably do better
      -- than this general case...
      condFltCode_sse2 :: NatM CondCode
    condFltCode_sse2 = do
        Platform
    platform <- NatM Platform
    getPlatform
        (Reg
    x_reg, OrdList Instr
    x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getNonClobberedReg CmmExpr
    x
        (Operand
    y_op, OrdList Instr
    y_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
    getOperand CmmExpr
    y
        let
            code :: OrdList Instr
    code = OrdList Instr
    x_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                   OrdList Instr
    y_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                      Format -> Operand -> Operand -> Instr
    CMP (Width -> Format
    floatFormat (Width -> Format) -> Width -> Format
    forall a b. (a -> b) -> a -> b
    $ Platform -> CmmExpr -> Width
    cmmExprWidth Platform
    platform CmmExpr
    x) Operand
    y_op (Reg -> Operand
    OpReg Reg
    x_reg)
            -- NB(1): we need to use the unsigned comparison operators on the
            -- result of this comparison.
        CondCode -> NatM CondCode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Cond -> OrdList Instr -> CondCode
    CondCode Bool
    True (Cond -> Cond
    condToUnsigned Cond
    cond) OrdList Instr
    code)

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

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

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

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

    -- integer assignment to memory

    -- specific case of adding/subtracting an integer to a particular address.
    -- ToDo: catch other cases where we can use an operation directly on a memory
    -- address.
    assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_IntCode Format
    pk CmmExpr
    addr (CmmMachOp MachOp
    op [CmmLoad CmmExpr
    addr2 CmmType
    _ AlignmentSpec
    _,
                                                     CmmLit (CmmInt Integer
    i Width
    _)])
       | CmmExpr
    addr CmmExpr -> CmmExpr -> Bool
    forall a. Eq a => a -> a -> Bool
    == CmmExpr
    addr2, Format
    pk Format -> Format -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Format
    II64 Bool -> Bool -> Bool
    || Integer -> Bool
    is32BitInteger Integer
    i,
         Just Format -> Operand -> Operand -> Instr
    instr <- MachOp -> Maybe (Format -> Operand -> Operand -> Instr)
    check MachOp
    op
       = do Amode AddrMode
    amode OrdList Instr
    code_addr <- CmmExpr -> NatM Amode
    getAmode CmmExpr
    addr
            let code :: OrdList Instr
    code = OrdList Instr
    code_addr OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                       Format -> Operand -> Operand -> Instr
    instr Format
    pk (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt (Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    i))) (AddrMode -> Operand
    OpAddr AddrMode
    amode)
            OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    code
       where
            check :: MachOp -> Maybe (Format -> Operand -> Operand -> Instr)
    check (MO_Add Width
    _) = (Format -> Operand -> Operand -> Instr)
    -> Maybe (Format -> Operand -> Operand -> Instr)
    forall a. a -> Maybe a
    Just Format -> Operand -> Operand -> Instr
    ADD
            check (MO_Sub Width
    _) = (Format -> Operand -> Operand -> Instr)
    -> Maybe (Format -> Operand -> Operand -> Instr)
    forall a. a -> Maybe a
    Just Format -> Operand -> Operand -> Instr
    SUB
            check MachOp
    _ = Maybe (Format -> Operand -> Operand -> Instr)
    forall a. Maybe a
    Nothing
            -- ToDo: more?

    -- general case
    assignMem_IntCode Format
    pk CmmExpr
    addr CmmExpr
    src = do
        Platform
    platform <- NatM Platform
    getPlatform
        Amode AddrMode
    addr OrdList Instr
    code_addr <- CmmExpr -> NatM Amode
    getAmode CmmExpr
    addr
        (OrdList Instr
    code_src, Operand
    op_src)   <- Platform -> CmmExpr -> NatM (OrdList Instr, Operand)
    get_op_RI Platform
    platform CmmExpr
    src
        let
            code :: OrdList Instr
    code = OrdList Instr
    code_src OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                   OrdList Instr
    code_addr OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                      Format -> Operand -> Operand -> Instr
    MOV Format
    pk Operand
    op_src (AddrMode -> Operand
    OpAddr AddrMode
    addr)
            -- NOTE: op_src is stable, so it will still be valid
            -- after code_addr.  This may involve the introduction
            -- of an extra MOV to a temporary register, but we hope
            -- the register allocator will get rid of it.
        --
        OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    code
      where
        get_op_RI :: Platform -> CmmExpr -> NatM (InstrBlock,Operand)   -- code, operator
        get_op_RI :: Platform -> CmmExpr -> NatM (OrdList Instr, Operand)
    get_op_RI Platform
    platform (CmmLit CmmLit
    lit) | Platform -> CmmLit -> Bool
    is32BitLit Platform
    platform CmmLit
    lit
          = (OrdList Instr, Operand) -> NatM (OrdList Instr, Operand)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    forall a. OrdList a
    nilOL, Imm -> Operand
    OpImm (CmmLit -> Imm
    litToImm CmmLit
    lit))
        get_op_RI Platform
    _ CmmExpr
    op
          = do (Reg
    reg,OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getNonClobberedReg CmmExpr
    op
               (OrdList Instr, Operand) -> NatM (OrdList Instr, Operand)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    code, Reg -> Operand
    OpReg Reg
    reg)

    -- Assign; dst is a reg, rhs is mem
    assignReg_IntCode :: Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_IntCode Format
    pk CmmReg
    reg (CmmLoad CmmExpr
    src CmmType
    _ AlignmentSpec
    _) = do
      Reg -> OrdList Instr
    load_code <- (Operand -> Operand -> Instr)
    -> CmmExpr -> NatM (Reg -> OrdList Instr)
    intLoadCode (Format -> Operand -> Operand -> Instr
    MOV Format
    pk) CmmExpr
    src
      Platform
    platform <- NCGConfig -> Platform
    ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NatM NCGConfig
    getConfig
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg -> OrdList Instr
    load_code (Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform CmmReg
    reg))

    -- dst is a reg, but src could be anything
    assignReg_IntCode Format
    _ CmmReg
    reg CmmExpr
    src = do
      Platform
    platform <- NCGConfig -> Platform
    ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NatM NCGConfig
    getConfig
      Reg -> OrdList Instr
    code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    src
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg -> OrdList Instr
    code (Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform CmmReg
    reg))

    -- Floating point assignment to memory
    assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_FltCode Format
    pk CmmExpr
    addr CmmExpr
    src = do
      (Reg
    src_reg, OrdList Instr
    src_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getNonClobberedReg CmmExpr
    src
      Amode AddrMode
    addr OrdList Instr
    addr_code <- CmmExpr -> NatM Amode
    getAmode CmmExpr
    addr
      let
            code :: OrdList Instr
    code = OrdList Instr
    src_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                   OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                   Format -> Operand -> Operand -> Instr
    MOV Format
    pk (Reg -> Operand
    OpReg Reg
    src_reg) (AddrMode -> Operand
    OpAddr AddrMode
    addr)

      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    code

    -- Floating point assignment to a register/temporary
    assignReg_FltCode :: Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_FltCode Format
    _ CmmReg
    reg CmmExpr
    src = do
      Reg -> OrdList Instr
    src_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    src
      Platform
    platform <- NCGConfig -> Platform
    ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NatM NCGConfig
    getConfig
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg -> OrdList Instr
    src_code (Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform CmmReg
    reg))

    genJump :: CmmExpr{-the branch target-} -> [Reg] -> NatM InstrBlock

    genJump :: CmmExpr -> [Reg] -> NatM (OrdList Instr)
    genJump (CmmLoad CmmExpr
    mem CmmType
    _ AlignmentSpec
    _) [Reg]
    regs = do
      Amode AddrMode
    target OrdList Instr
    code <- CmmExpr -> NatM Amode
    getAmode CmmExpr
    mem
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Operand -> [Reg] -> Instr
    JMP (AddrMode -> Operand
    OpAddr AddrMode
    target) [Reg]
    regs)

    genJump (CmmLit CmmLit
    lit) [Reg]
    regs =
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Operand -> [Reg] -> Instr
    JMP (Imm -> Operand
    OpImm (CmmLit -> Imm
    litToImm CmmLit
    lit)) [Reg]
    regs))

    genJump CmmExpr
    expr [Reg]
    regs = do
      (Reg
    reg,OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    expr
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Operand -> [Reg] -> Instr
    JMP (Reg -> Operand
    OpReg Reg
    reg) [Reg]
    regs)

    -- -----------------------------------------------------------------------------
    --  Unconditional branches

    genBranch :: BlockId -> InstrBlock
    genBranch :: Label -> OrdList Instr
    genBranch = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL ([Instr] -> OrdList Instr)
    -> (Label -> [Instr]) -> Label -> OrdList Instr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Label -> [Instr]
    mkJumpInstr

    -- -----------------------------------------------------------------------------
    --  Conditional jumps/branches

    {-
    Conditional jumps are always to local labels, so we can use branch
    instructions.  We peek at the arguments to decide what kind of
    comparison to do.

    I386: First, we have to ensure that the condition
    codes are set according to the supplied comparison operation.
    -}

    {-  Note [64-bit integer comparisons on 32-bit]
        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

        When doing these comparisons there are 2 kinds of
        comparisons.

        * Comparison for equality (or lack thereof)

        We use xor to check if high/low bits are
        equal. Then combine the results using or and
        perform a single conditional jump based on the
        result.

        * Other comparisons:

        We map all other comparisons to the >= operation.
        Why? Because it's easy to encode it with a single
        conditional jump.

        We do this by first computing [r1_lo - r2_lo]
        and use the carry flag to compute
        [r1_high - r2_high - CF].

        At which point if r1 >= r2 then the result will be
        positive. Otherwise negative so we can branch on this
        condition.

    -}

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

    genCondBranch :: Label -> Label -> Label -> CmmExpr -> NatM (OrdList Instr)
    genCondBranch Label
    bid Label
    id Label
    false CmmExpr
    expr = do
      Bool
    is32Bit <- NatM Bool
    is32BitPlatform
      Bool -> Label -> Label -> Label -> CmmExpr -> NatM (OrdList Instr)
    genCondBranch' Bool
    is32Bit Label
    bid Label
    id Label
    false CmmExpr
    expr

    -- | We return the instructions generated.
    genCondBranch' :: Bool -> BlockId -> BlockId -> BlockId -> CmmExpr
                   -> NatM InstrBlock

    -- 64-bit integer comparisons on 32-bit
    -- See Note [64-bit integer comparisons on 32-bit]
    genCondBranch' :: Bool -> Label -> Label -> Label -> CmmExpr -> NatM (OrdList Instr)
    genCondBranch' Bool
    is32Bit Label
    _bid Label
    true Label
    false (CmmMachOp MachOp
    mop [CmmExpr
    e1,CmmExpr
    e2])
      | Bool
    is32Bit, Just Width
    W64 <- MachOp -> Maybe Width
    maybeIntComparison MachOp
    mop = do

      RegCode64 OrdList Instr
    code1 Reg
    r1hi Reg
    r1lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    e1
      RegCode64 OrdList Instr
    code2 Reg
    r2hi Reg
    r2lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    e2
      let cond :: Cond
    cond = MachOp -> Cond
    machOpToCond MachOp
    mop :: Cond

      -- we mustn't clobber r1/r2 so we use temporaries
      Reg
    tmp1 <- Format -> NatM Reg
    getNewRegNat Format
    II32
      Reg
    tmp2 <- Format -> NatM Reg
    getNewRegNat Format
    II32

      let cmpCode :: OrdList Instr
    cmpCode = Cond
    -> Label
    -> Label
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> OrdList Instr
    intComparison Cond
    cond Label
    true Label
    false Reg
    r1hi Reg
    r1lo Reg
    r2hi Reg
    r2lo Reg
    tmp1 Reg
    tmp2
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    code1 OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code2 OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    cmpCode

      where
        intComparison :: Cond
    -> Label
    -> Label
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> OrdList Instr
    intComparison Cond
    cond Label
    true Label
    false Reg
    r1_hi Reg
    r1_lo Reg
    r2_hi Reg
    r2_lo Reg
    tmp1 Reg
    tmp2 =
          case Cond
    cond of
            -- Impossible results of machOpToCond
            Cond
    ALWAYS  -> String -> OrdList Instr
    forall a. String -> a
    panic String
    "impossible"
            Cond
    NEG     -> String -> OrdList Instr
    forall a. String -> a
    panic String
    "impossible"
            Cond
    POS     -> String -> OrdList Instr
    forall a. String -> a
    panic String
    "impossible"
            Cond
    CARRY   -> String -> OrdList Instr
    forall a. String -> a
    panic String
    "impossible"
            Cond
    OFLO    -> String -> OrdList Instr
    forall a. String -> a
    panic String
    "impossible"
            Cond
    PARITY  -> String -> OrdList Instr
    forall a. String -> a
    panic String
    "impossible"
            Cond
    NOTPARITY -> String -> OrdList Instr
    forall a. String -> a
    panic String
    "impossible"
            -- Special case #1 x == y and x != y
            Cond
    EQQ -> OrdList Instr
    cmpExact
            Cond
    NE  -> OrdList Instr
    cmpExact
            -- [x >= y]
            Cond
    GE  -> OrdList Instr
    cmpGE
            Cond
    GEU -> OrdList Instr
    cmpGE
            -- [x >  y] <==> ![y >= x]
            Cond
    GTT -> Cond
    -> Label
    -> Label
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> OrdList Instr
    intComparison Cond
    GE  Label
    false Label
    true Reg
    r2_hi Reg
    r2_lo Reg
    r1_hi Reg
    r1_lo Reg
    tmp1 Reg
    tmp2
            Cond
    GU  -> Cond
    -> Label
    -> Label
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> OrdList Instr
    intComparison Cond
    GEU Label
    false Label
    true Reg
    r2_hi Reg
    r2_lo Reg
    r1_hi Reg
    r1_lo Reg
    tmp1 Reg
    tmp2
            -- [x <= y] <==> [y >= x]
            Cond
    LE  -> Cond
    -> Label
    -> Label
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> OrdList Instr
    intComparison Cond
    GE  Label
    true Label
    false Reg
    r2_hi Reg
    r2_lo Reg
    r1_hi Reg
    r1_lo Reg
    tmp1 Reg
    tmp2
            Cond
    LEU -> Cond
    -> Label
    -> Label
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> OrdList Instr
    intComparison Cond
    GEU Label
    true Label
    false Reg
    r2_hi Reg
    r2_lo Reg
    r1_hi Reg
    r1_lo Reg
    tmp1 Reg
    tmp2
            -- [x <  y] <==> ![x >= x]
            Cond
    LTT -> Cond
    -> Label
    -> Label
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> OrdList Instr
    intComparison Cond
    GE  Label
    false Label
    true Reg
    r1_hi Reg
    r1_lo Reg
    r2_hi Reg
    r2_lo Reg
    tmp1 Reg
    tmp2
            Cond
    LU  -> Cond
    -> Label
    -> Label
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> Reg
    -> OrdList Instr
    intComparison Cond
    GEU Label
    false Label
    true Reg
    r1_hi Reg
    r1_lo Reg
    r2_hi Reg
    r2_lo Reg
    tmp1 Reg
    tmp2
          where
            cmpExact :: OrdList Instr
            cmpExact :: OrdList Instr
    cmpExact =
              [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                [ Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    r1_hi) (Reg -> Operand
    OpReg Reg
    tmp1)
                , Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    r1_lo) (Reg -> Operand
    OpReg Reg
    tmp2)
                , Format -> Operand -> Operand -> Instr
    XOR Format
    II32 (Reg -> Operand
    OpReg Reg
    r2_hi) (Reg -> Operand
    OpReg Reg
    tmp1)
                , Format -> Operand -> Operand -> Instr
    XOR Format
    II32 (Reg -> Operand
    OpReg Reg
    r2_lo) (Reg -> Operand
    OpReg Reg
    tmp2)
                , Format -> Operand -> Operand -> Instr
    OR  Format
    II32 (Reg -> Operand
    OpReg Reg
    tmp1)  (Reg -> Operand
    OpReg Reg
    tmp2)
                , Cond -> Label -> Instr
    JXX Cond
    cond Label
    true
                , Cond -> Label -> Instr
    JXX Cond
    ALWAYS Label
    false
                ]
            cmpGE :: OrdList Instr
    cmpGE = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                [ Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    r1_hi) (Reg -> Operand
    OpReg Reg
    tmp1)
                , Format -> Operand -> Operand -> Instr
    CMP Format
    II32 (Reg -> Operand
    OpReg Reg
    r2_lo) (Reg -> Operand
    OpReg Reg
    r1_lo)
                , Format -> Operand -> Operand -> Instr
    SBB Format
    II32 (Reg -> Operand
    OpReg Reg
    r2_hi) (Reg -> Operand
    OpReg Reg
    tmp1)
                , Cond -> Label -> Instr
    JXX Cond
    cond Label
    true
                , Cond -> Label -> Instr
    JXX Cond
    ALWAYS Label
    false ]

    genCondBranch' Bool
    _ Label
    bid Label
    id Label
    false CmmExpr
    bool = do
      CondCode Bool
    is_float Cond
    cond OrdList Instr
    cond_code <- CmmExpr -> NatM CondCode
    getCondCode CmmExpr
    bool
      Bool
    use_sse2 <- NatM Bool
    sse2Enabled
      if Bool -> Bool
    not Bool
    is_float Bool -> Bool -> Bool
    || Bool -> Bool
    not Bool
    use_sse2
        then
            OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    cond_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Cond -> Label -> Instr
    JXX Cond
    cond Label
    id OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Label -> OrdList Instr
    genBranch Label
    false)
        else do
            -- See Note [SSE Parity Checks]
            let jmpFalse :: OrdList Instr
    jmpFalse = Label -> OrdList Instr
    genBranch Label
    false
                code :: OrdList Instr
    code
                    = case Cond
    cond of
                      Cond
    NE  -> OrdList Instr
    or_unordered
                      Cond
    GU  -> OrdList Instr
    plain_test
                      Cond
    GEU -> OrdList Instr
    plain_test
                      -- Use ASSERT so we don't break releases if
                      -- LTT/LE creep in somehow.
                      Cond
    LTT ->
                        Bool -> SDoc -> OrdList Instr -> OrdList Instr
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr Bool
    False (String -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr String
    "Should have been turned into >")
                        OrdList Instr
    and_ordered
                      Cond
    LE  ->
                        Bool -> SDoc -> OrdList Instr -> OrdList Instr
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr Bool
    False (String -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr String
    "Should have been turned into >=")
                        OrdList Instr
    and_ordered
                      Cond
    _   -> OrdList Instr
    and_ordered

                plain_test :: OrdList Instr
    plain_test = Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (
                      Cond -> Label -> Instr
    JXX Cond
    cond Label
    id
                    ) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    jmpFalse
                or_unordered :: OrdList Instr
    or_unordered = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                      Cond -> Label -> Instr
    JXX Cond
    cond Label
    id,
                      Cond -> Label -> Instr
    JXX Cond
    PARITY Label
    id
                    ] OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    jmpFalse
                and_ordered :: OrdList Instr
    and_ordered = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                      Cond -> Label -> Instr
    JXX Cond
    PARITY Label
    false,
                      Cond -> Label -> Instr
    JXX Cond
    cond Label
    id,
                      Cond -> Label -> Instr
    JXX Cond
    ALWAYS Label
    false
                    ]
            (CFG -> CFG) -> NatM ()
    updateCfgNat (\CFG
    cfg -> CFG -> (EdgeWeight -> EdgeWeight) -> Label -> Label -> CFG
    adjustEdgeWeight CFG
    cfg (EdgeWeight -> EdgeWeight -> EdgeWeight
    forall a. Num a => a -> a -> a
    +EdgeWeight
    3) Label
    bid Label
    false)
            OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    cond_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code)

    {-  Note [Introducing cfg edges inside basic blocks]
        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

        During instruction selection a statement `s`
        in a block B with control of the sort: B -> C
        will sometimes result in control
        flow of the sort:

                ┌ < ┐
                v   ^
          B ->  B1  ┴ -> C

        as is the case for some atomic operations.

        Now to keep the CFG in sync when introducing B1 we clearly
        want to insert it between B and C. However there is
        a catch when we have to deal with self loops.

        We might start with code and a CFG of these forms:

        loop:
            stmt1               ┌ < ┐
            ....                v   ^
            stmtX              loop ┘
            stmtY
            ....
            goto loop:

        Now we introduce B1:
                                ┌ ─ ─ ─ ─ ─┐
            loop:               │   ┌ <  ┐ │
            instrs              v   │    │ ^
            ....               loop ┴ B1 ┴ ┘
            instrsFromX
            stmtY
            goto loop:

        This is simple, all outgoing edges from loop now simply
        start from B1 instead and the code generator knows which
        new edges it introduced for the self loop of B1.

        Disaster strikes if the statement Y follows the same pattern.
        If we apply the same rule that all outgoing edges change then
        we end up with:

            loop ─> B1 ─> B2 ┬─┐
              │      │    └─<┤ │
              │      └───<───┘ │
              └───────<────────┘

        This is problematic. The edge B1->B1 is modified as expected.
        However the modification is wrong!

        The assembly in this case looked like this:

        _loop:
            <instrs>
        _B1:
            ...
            cmpxchgq ...
            jne _B1
            <instrs>
            <end _B1>
        _B2:
            ...
            cmpxchgq ...
            jne _B2
            <instrs>
            jmp loop

        There is no edge _B2 -> _B1 here. It's still a self loop onto _B1.

        The problem here is that really B1 should be two basic blocks.
        Otherwise we have control flow in the *middle* of a basic block.
        A contradiction!

        So to account for this we add yet another basic block marker:

        _B:
            <instrs>
        _B1:
            ...
            cmpxchgq ...
            jne _B1
            jmp _B1'
        _B1':
            <instrs>
            <end _B1>
        _B2:
            ...

        Now when inserting B2 we will only look at the outgoing edges of B1' and
        everything will work out nicely.

        You might also wonder why we don't insert jumps at the end of _B1'. There is
        no way another block ends up jumping to the labels _B1 or _B2 since they are
        essentially invisible to other blocks. View them as control flow labels local
        to the basic block if you'd like.

        Not doing this ultimately caused (part 2 of) #17334.
    -}

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

    -- Now the biggest nightmare---calls.  Most of the nastiness is buried in
    -- @get_arg@, which moves the arguments to the correct registers/stack
    -- locations.  Apart from that, the code is easy.
    --
    -- (If applicable) Do not fill the delay slots here; you will confuse the
    -- register allocator.
    --
    -- See Note [Keeping track of the current block] for information why we need
    -- to take/return a block id.

    genForeignCall
        :: ForeignTarget -- ^ function to call
        -> [CmmFormal]   -- ^ where to put the result
        -> [CmmActual]   -- ^ arguments (of mixed type)
        -> BlockId       -- ^ The block we are in
        -> NatM (InstrBlock, Maybe BlockId)

    genForeignCall :: ForeignTarget
    -> [LocalReg]
    -> [CmmExpr]
    -> Label
    -> NatM (OrdList Instr, Maybe Label)
    genForeignCall ForeignTarget
    target [LocalReg]
    dst [CmmExpr]
    args Label
    bid = do
      case ForeignTarget
    target of
        PrimTarget CallishMachOp
    prim         -> Label
    -> CallishMachOp
    -> [LocalReg]
    -> [CmmExpr]
    -> NatM (OrdList Instr, Maybe Label)
    genPrim Label
    bid CallishMachOp
    prim [LocalReg]
    dst [CmmExpr]
    args
        ForeignTarget CmmExpr
    addr ForeignConvention
    conv -> (,Maybe Label
    forall a. Maybe a
    Nothing) (OrdList Instr -> (OrdList Instr, Maybe Label))
    -> NatM (OrdList Instr) -> NatM (OrdList Instr, Maybe Label)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Label
    -> CmmExpr
    -> ForeignConvention
    -> [LocalReg]
    -> [CmmExpr]
    -> NatM (OrdList Instr)
    genCCall Label
    bid CmmExpr
    addr ForeignConvention
    conv [LocalReg]
    dst [CmmExpr]
    args

    genPrim
        :: BlockId       -- ^ The block we are in
        -> CallishMachOp -- ^ MachOp
        -> [CmmFormal]   -- ^ where to put the result
        -> [CmmActual]   -- ^ arguments (of mixed type)
        -> NatM (InstrBlock, Maybe BlockId)

    -- First we deal with cases which might introduce new blocks in the stream.
    genPrim :: Label
    -> CallishMachOp
    -> [LocalReg]
    -> [CmmExpr]
    -> NatM (OrdList Instr, Maybe Label)
    genPrim Label
    bid (MO_AtomicRMW Width
    width AtomicMachOp
    amop) [LocalReg
    dst] [CmmExpr
    addr, CmmExpr
    n]
      = Label
    -> Width
    -> AtomicMachOp
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr, Maybe Label)
    genAtomicRMW Label
    bid Width
    width AtomicMachOp
    amop LocalReg
    dst CmmExpr
    addr CmmExpr
    n
    genPrim Label
    bid (MO_Ctz Width
    width) [LocalReg
    dst] [CmmExpr
    src]
      = Label
    -> Width
    -> LocalReg
    -> CmmExpr
    -> NatM (OrdList Instr, Maybe Label)
    genCtz Label
    bid Width
    width LocalReg
    dst CmmExpr
    src

    -- Then we deal with cases which not introducing new blocks in the stream.
    genPrim Label
    bid CallishMachOp
    prim [LocalReg]
    dst [CmmExpr]
    args
      = (,Maybe Label
    forall a. Maybe a
    Nothing) (OrdList Instr -> (OrdList Instr, Maybe Label))
    -> NatM (OrdList Instr) -> NatM (OrdList Instr, Maybe Label)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Label
    -> CallishMachOp -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genSimplePrim Label
    bid CallishMachOp
    prim [LocalReg]
    dst [CmmExpr]
    args

    genSimplePrim
        :: BlockId       -- ^ the block we are in
        -> CallishMachOp -- ^ MachOp
        -> [CmmFormal]   -- ^ where to put the result
        -> [CmmActual]   -- ^ arguments (of mixed type)
        -> NatM InstrBlock
    genSimplePrim :: Label
    -> CallishMachOp -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genSimplePrim Label
    bid (MO_Memcpy Int
    align)    []      [CmmExpr
    dst,CmmExpr
    src,CmmExpr
    n]    = Label
    -> Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genMemCpy  Label
    bid Int
    align CmmExpr
    dst CmmExpr
    src CmmExpr
    n
    genSimplePrim Label
    bid (MO_Memmove Int
    align)   []      [CmmExpr
    dst,CmmExpr
    src,CmmExpr
    n]    = Label
    -> Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    forall p.
    Label -> p -> CmmExpr -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genMemMove Label
    bid Int
    align CmmExpr
    dst CmmExpr
    src CmmExpr
    n
    genSimplePrim Label
    bid (MO_Memcmp Int
    align)    [LocalReg
    res]   [CmmExpr
    dst,CmmExpr
    src,CmmExpr
    n]    = Label
    -> Int
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    forall p.
    Label
    -> p
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genMemCmp  Label
    bid Int
    align LocalReg
    res CmmExpr
    dst CmmExpr
    src CmmExpr
    n
    genSimplePrim Label
    bid (MO_Memset Int
    align)    []      [CmmExpr
    dst,CmmExpr
    c,CmmExpr
    n]      = Label
    -> Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genMemSet  Label
    bid Int
    align CmmExpr
    dst CmmExpr
    c CmmExpr
    n
    genSimplePrim Label
    _   CallishMachOp
    MO_ReadBarrier       []      []             = OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    forall a. OrdList a
    nilOL -- barriers compile to no code on x86/x86-64;
    genSimplePrim Label
    _   CallishMachOp
    MO_WriteBarrier      []      []             = OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    forall a. OrdList a
    nilOL -- we keep it this long in order to prevent earlier optimisations.
    genSimplePrim Label
    _   CallishMachOp
    MO_Touch             []      [CmmExpr
    _]            = OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    forall a. OrdList a
    nilOL
    genSimplePrim Label
    _   (MO_Prefetch_Data Int
    n) []      [CmmExpr
    src]          = Int -> CmmExpr -> NatM (OrdList Instr)
    genPrefetchData Int
    n CmmExpr
    src
    genSimplePrim Label
    _   (MO_BSwap Width
    width)     [LocalReg
    dst]   [CmmExpr
    src]          = Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genByteSwap Width
    width LocalReg
    dst CmmExpr
    src
    genSimplePrim Label
    bid (MO_BRev Width
    width)      [LocalReg
    dst]   [CmmExpr
    src]          = Label -> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genBitRev Label
    bid Width
    width LocalReg
    dst CmmExpr
    src
    genSimplePrim Label
    bid (MO_PopCnt Width
    width)    [LocalReg
    dst]   [CmmExpr
    src]          = Label -> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genPopCnt Label
    bid Width
    width LocalReg
    dst CmmExpr
    src
    genSimplePrim Label
    bid (MO_Pdep Width
    width)      [LocalReg
    dst]   [CmmExpr
    src,CmmExpr
    mask]     = Label
    -> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genPdep Label
    bid Width
    width LocalReg
    dst CmmExpr
    src CmmExpr
    mask
    genSimplePrim Label
    bid (MO_Pext Width
    width)      [LocalReg
    dst]   [CmmExpr
    src,CmmExpr
    mask]     = Label
    -> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genPext Label
    bid Width
    width LocalReg
    dst CmmExpr
    src CmmExpr
    mask
    genSimplePrim Label
    bid (MO_Clz Width
    width)       [LocalReg
    dst]   [CmmExpr
    src]          = Label -> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genClz Label
    bid Width
    width LocalReg
    dst CmmExpr
    src
    genSimplePrim Label
    bid (MO_UF_Conv Width
    width)   [LocalReg
    dst]   [CmmExpr
    src]          = Label -> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genWordToFloat Label
    bid Width
    width LocalReg
    dst CmmExpr
    src
    genSimplePrim Label
    _   (MO_AtomicRead Width
    w)    [LocalReg
    dst]   [CmmExpr
    addr]         = Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genAtomicRead Width
    w LocalReg
    dst CmmExpr
    addr
    genSimplePrim Label
    _   (MO_AtomicWrite Width
    w)   []      [CmmExpr
    addr,CmmExpr
    val]     = Width -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genAtomicWrite Width
    w CmmExpr
    addr CmmExpr
    val
    genSimplePrim Label
    bid (MO_Cmpxchg Width
    width)   [LocalReg
    dst]   [CmmExpr
    addr,CmmExpr
    old,CmmExpr
    new] = Label
    -> Width
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genCmpXchg Label
    bid Width
    width LocalReg
    dst CmmExpr
    addr CmmExpr
    old CmmExpr
    new
    genSimplePrim Label
    _   (MO_Xchg Width
    width)      [LocalReg
    dst]   [CmmExpr
    addr, CmmExpr
    value]  = Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genXchg Width
    width LocalReg
    dst CmmExpr
    addr CmmExpr
    value
    genSimplePrim Label
    _   (MO_AddWordC Width
    w)      [LocalReg
    r,LocalReg
    c]   [CmmExpr
    x,CmmExpr
    y]          = Width
    -> (Format -> Operand -> Operand -> Instr)
    -> (Format -> Maybe (Operand -> Operand -> Instr))
    -> Cond
    -> LocalReg
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genAddSubRetCarry Width
    w Format -> Operand -> Operand -> Instr
    ADD_CC (Maybe (Operand -> Operand -> Instr)
    -> Format -> Maybe (Operand -> Operand -> Instr)
    forall a b. a -> b -> a
    const Maybe (Operand -> Operand -> Instr)
    forall a. Maybe a
    Nothing) Cond
    CARRY LocalReg
    r LocalReg
    c CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   (MO_SubWordC Width
    w)      [LocalReg
    r,LocalReg
    c]   [CmmExpr
    x,CmmExpr
    y]          = Width
    -> (Format -> Operand -> Operand -> Instr)
    -> (Format -> Maybe (Operand -> Operand -> Instr))
    -> Cond
    -> LocalReg
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genAddSubRetCarry Width
    w Format -> Operand -> Operand -> Instr
    SUB_CC (Maybe (Operand -> Operand -> Instr)
    -> Format -> Maybe (Operand -> Operand -> Instr)
    forall a b. a -> b -> a
    const Maybe (Operand -> Operand -> Instr)
    forall a. Maybe a
    Nothing) Cond
    CARRY LocalReg
    r LocalReg
    c CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   (MO_AddIntC Width
    w)       [LocalReg
    r,LocalReg
    c]   [CmmExpr
    x,CmmExpr
    y]          = Width
    -> (Format -> Operand -> Operand -> Instr)
    -> (Format -> Maybe (Operand -> Operand -> Instr))
    -> Cond
    -> LocalReg
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genAddSubRetCarry Width
    w Format -> Operand -> Operand -> Instr
    ADD_CC ((Operand -> Operand -> Instr)
    -> Maybe (Operand -> Operand -> Instr)
    forall a. a -> Maybe a
    Just ((Operand -> Operand -> Instr)
     -> Maybe (Operand -> Operand -> Instr))
    -> (Format -> Operand -> Operand -> Instr)
    -> Format
    -> Maybe (Operand -> Operand -> Instr)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Format -> Operand -> Operand -> Instr
    ADD_CC) Cond
    OFLO  LocalReg
    r LocalReg
    c CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   (MO_SubIntC Width
    w)       [LocalReg
    r,LocalReg
    c]   [CmmExpr
    x,CmmExpr
    y]          = Width
    -> (Format -> Operand -> Operand -> Instr)
    -> (Format -> Maybe (Operand -> Operand -> Instr))
    -> Cond
    -> LocalReg
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genAddSubRetCarry Width
    w Format -> Operand -> Operand -> Instr
    SUB_CC (Maybe (Operand -> Operand -> Instr)
    -> Format -> Maybe (Operand -> Operand -> Instr)
    forall a b. a -> b -> a
    const Maybe (Operand -> Operand -> Instr)
    forall a. Maybe a
    Nothing) Cond
    OFLO  LocalReg
    r LocalReg
    c CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   (MO_Add2 Width
    w)          [LocalReg
    h,LocalReg
    l]   [CmmExpr
    x,CmmExpr
    y]          = Width
    -> LocalReg
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genAddWithCarry Width
    w LocalReg
    h LocalReg
    l CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   (MO_U_Mul2 Width
    w)        [LocalReg
    h,LocalReg
    l]   [CmmExpr
    x,CmmExpr
    y]          = Width
    -> LocalReg
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genUnsignedLargeMul Width
    w LocalReg
    h LocalReg
    l CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   (MO_S_Mul2 Width
    w)        [LocalReg
    c,LocalReg
    h,LocalReg
    l] [CmmExpr
    x,CmmExpr
    y]          = Width
    -> LocalReg
    -> LocalReg
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genSignedLargeMul Width
    w LocalReg
    c LocalReg
    h LocalReg
    l CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   (MO_S_QuotRem Width
    w)     [LocalReg
    q,LocalReg
    r]   [CmmExpr
    x,CmmExpr
    y]          = Width
    -> Bool
    -> LocalReg
    -> LocalReg
    -> Maybe CmmExpr
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genQuotRem Width
    w Bool
    True  LocalReg
    q LocalReg
    r Maybe CmmExpr
    forall a. Maybe a
    Nothing   CmmExpr
    x  CmmExpr
    y
    genSimplePrim Label
    _   (MO_U_QuotRem Width
    w)     [LocalReg
    q,LocalReg
    r]   [CmmExpr
    x,CmmExpr
    y]          = Width
    -> Bool
    -> LocalReg
    -> LocalReg
    -> Maybe CmmExpr
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genQuotRem Width
    w Bool
    False LocalReg
    q LocalReg
    r Maybe CmmExpr
    forall a. Maybe a
    Nothing   CmmExpr
    x  CmmExpr
    y
    genSimplePrim Label
    _   (MO_U_QuotRem2 Width
    w)    [LocalReg
    q,LocalReg
    r]   [CmmExpr
    hx,CmmExpr
    lx,CmmExpr
    y]      = Width
    -> Bool
    -> LocalReg
    -> LocalReg
    -> Maybe CmmExpr
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genQuotRem Width
    w Bool
    False LocalReg
    q LocalReg
    r (CmmExpr -> Maybe CmmExpr
    forall a. a -> Maybe a
    Just CmmExpr
    hx) CmmExpr
    lx CmmExpr
    y
    genSimplePrim Label
    _   CallishMachOp
    MO_F32_Fabs          [LocalReg
    dst]   [CmmExpr
    src]          = Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genFloatAbs Width
    W32 LocalReg
    dst CmmExpr
    src
    genSimplePrim Label
    _   CallishMachOp
    MO_F64_Fabs          [LocalReg
    dst]   [CmmExpr
    src]          = Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genFloatAbs Width
    W64 LocalReg
    dst CmmExpr
    src
    genSimplePrim Label
    _   CallishMachOp
    MO_F32_Sqrt          [LocalReg
    dst]   [CmmExpr
    src]          = Format -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genFloatSqrt Format
    FF32 LocalReg
    dst CmmExpr
    src
    genSimplePrim Label
    _   CallishMachOp
    MO_F64_Sqrt          [LocalReg
    dst]   [CmmExpr
    src]          = Format -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genFloatSqrt Format
    FF64 LocalReg
    dst CmmExpr
    src
    genSimplePrim Label
    bid CallishMachOp
    MO_F32_Sin           [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "sinf") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F32_Cos           [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "cosf") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F32_Tan           [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "tanf") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F32_Exp           [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "expf") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F32_ExpM1         [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "expm1f") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F32_Log           [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "logf") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F32_Log1P         [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "log1pf") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F32_Asin          [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "asinf") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F32_Acos          [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "acosf") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F32_Atan          [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "atanf") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F32_Sinh          [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "sinhf") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F32_Cosh          [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "coshf") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F32_Tanh          [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "tanhf") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F32_Pwr           [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "powf")  [LocalReg
    dst] [CmmExpr
    x,CmmExpr
    y]
    genSimplePrim Label
    bid CallishMachOp
    MO_F32_Asinh         [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "asinhf") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F32_Acosh         [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "acoshf") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F32_Atanh         [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "atanhf") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F64_Sin           [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "sin") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F64_Cos           [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "cos") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F64_Tan           [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "tan") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F64_Exp           [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "exp") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F64_ExpM1         [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "expm1") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F64_Log           [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "log") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F64_Log1P         [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "log1p") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F64_Asin          [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "asin") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F64_Acos          [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "acos") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F64_Atan          [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "atan") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F64_Sinh          [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "sinh") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F64_Cosh          [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "cosh") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F64_Tanh          [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "tanh") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F64_Pwr           [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "pow")  [LocalReg
    dst] [CmmExpr
    x,CmmExpr
    y]
    genSimplePrim Label
    bid CallishMachOp
    MO_F64_Asinh         [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "asinh") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F64_Acosh         [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "acosh") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_F64_Atanh         [LocalReg
    dst]   [CmmExpr
    src]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "atanh") [LocalReg
    dst] [CmmExpr
    src]
    genSimplePrim Label
    bid CallishMachOp
    MO_SuspendThread     [LocalReg
    tok]   [CmmExpr
    rs,CmmExpr
    i]         = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genRTSCCall Label
    bid (String -> FastString
    fsLit String
    "suspendThread") [LocalReg
    tok] [CmmExpr
    rs,CmmExpr
    i]
    genSimplePrim Label
    bid CallishMachOp
    MO_ResumeThread      [LocalReg
    rs]    [CmmExpr
    tok]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genRTSCCall Label
    bid (String -> FastString
    fsLit String
    "resumeThread") [LocalReg
    rs] [CmmExpr
    tok]
    genSimplePrim Label
    _   CallishMachOp
    MO_I64_ToI           [LocalReg
    dst]   [CmmExpr
    src]          = LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genInt64ToInt LocalReg
    dst CmmExpr
    src
    genSimplePrim Label
    _   CallishMachOp
    MO_I64_FromI         [LocalReg
    dst]   [CmmExpr
    src]          = LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genIntToInt64 LocalReg
    dst CmmExpr
    src
    genSimplePrim Label
    _   CallishMachOp
    MO_W64_ToW           [LocalReg
    dst]   [CmmExpr
    src]          = LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genWord64ToWord LocalReg
    dst CmmExpr
    src
    genSimplePrim Label
    _   CallishMachOp
    MO_W64_FromW         [LocalReg
    dst]   [CmmExpr
    src]          = LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genWordToWord64 LocalReg
    dst CmmExpr
    src
    genSimplePrim Label
    _   CallishMachOp
    MO_x64_Neg           [LocalReg
    dst]   [CmmExpr
    src]          = LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genNeg64 LocalReg
    dst CmmExpr
    src
    genSimplePrim Label
    _   CallishMachOp
    MO_x64_Add           [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genAdd64 LocalReg
    dst CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   CallishMachOp
    MO_x64_Sub           [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genSub64 LocalReg
    dst CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    bid CallishMachOp
    MO_x64_Mul           [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genPrimCCall Label
    bid (String -> FastString
    fsLit String
    "hs_mul64") [LocalReg
    dst] [CmmExpr
    x,CmmExpr
    y]
    genSimplePrim Label
    bid CallishMachOp
    MO_I64_Quot          [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genPrimCCall Label
    bid (String -> FastString
    fsLit String
    "hs_quotInt64") [LocalReg
    dst] [CmmExpr
    x,CmmExpr
    y]
    genSimplePrim Label
    bid CallishMachOp
    MO_I64_Rem           [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genPrimCCall Label
    bid (String -> FastString
    fsLit String
    "hs_remInt64") [LocalReg
    dst] [CmmExpr
    x,CmmExpr
    y]
    genSimplePrim Label
    bid CallishMachOp
    MO_W64_Quot          [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genPrimCCall Label
    bid (String -> FastString
    fsLit String
    "hs_quotWord64") [LocalReg
    dst] [CmmExpr
    x,CmmExpr
    y]
    genSimplePrim Label
    bid CallishMachOp
    MO_W64_Rem           [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genPrimCCall Label
    bid (String -> FastString
    fsLit String
    "hs_remWord64") [LocalReg
    dst] [CmmExpr
    x,CmmExpr
    y]
    genSimplePrim Label
    _   CallishMachOp
    MO_x64_And           [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genAnd64 LocalReg
    dst CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   CallishMachOp
    MO_x64_Or            [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genOr64  LocalReg
    dst CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   CallishMachOp
    MO_x64_Xor           [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genXor64 LocalReg
    dst CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   CallishMachOp
    MO_x64_Not           [LocalReg
    dst]   [CmmExpr
    src]          = LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genNot64 LocalReg
    dst CmmExpr
    src
    genSimplePrim Label
    bid CallishMachOp
    MO_x64_Shl           [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    n]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genPrimCCall Label
    bid (String -> FastString
    fsLit String
    "hs_uncheckedShiftL64") [LocalReg
    dst] [CmmExpr
    x,CmmExpr
    n]
    genSimplePrim Label
    bid CallishMachOp
    MO_I64_Shr           [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    n]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genPrimCCall Label
    bid (String -> FastString
    fsLit String
    "hs_uncheckedIShiftRA64") [LocalReg
    dst] [CmmExpr
    x,CmmExpr
    n]
    genSimplePrim Label
    bid CallishMachOp
    MO_W64_Shr           [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    n]          = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genPrimCCall Label
    bid (String -> FastString
    fsLit String
    "hs_uncheckedShiftRL64") [LocalReg
    dst] [CmmExpr
    x,CmmExpr
    n]
    genSimplePrim Label
    _   CallishMachOp
    MO_x64_Eq            [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genEq64 LocalReg
    dst CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   CallishMachOp
    MO_x64_Ne            [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genNe64 LocalReg
    dst CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   CallishMachOp
    MO_I64_Ge            [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genGeInt64 LocalReg
    dst CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   CallishMachOp
    MO_I64_Gt            [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genGtInt64 LocalReg
    dst CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   CallishMachOp
    MO_I64_Le            [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genLeInt64 LocalReg
    dst CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   CallishMachOp
    MO_I64_Lt            [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genLtInt64 LocalReg
    dst CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   CallishMachOp
    MO_W64_Ge            [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genGeWord64 LocalReg
    dst CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   CallishMachOp
    MO_W64_Gt            [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genGtWord64 LocalReg
    dst CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   CallishMachOp
    MO_W64_Le            [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genLeWord64 LocalReg
    dst CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   CallishMachOp
    MO_W64_Lt            [LocalReg
    dst]   [CmmExpr
    x,CmmExpr
    y]          = LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genLtWord64 LocalReg
    dst CmmExpr
    x CmmExpr
    y
    genSimplePrim Label
    _   CallishMachOp
    op                   [LocalReg]
    dst     [CmmExpr]
    args           = do
      Platform
    platform <- NCGConfig -> Platform
    ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NatM NCGConfig
    getConfig
      String -> SDoc -> NatM (OrdList Instr)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "genSimplePrim: unhandled primop" ((SDoc, [LocalReg], [SDoc]) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (CallishMachOp -> SDoc
    pprCallishMachOp CallishMachOp
    op, [LocalReg]
    dst, (CmmExpr -> SDoc) -> [CmmExpr] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform) [CmmExpr]
    args))

    {-
    Note [Evaluate C-call arguments before placing in destination registers]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    When producing code for C calls we must take care when placing arguments
    in their final registers. Specifically, we must ensure that temporary register
    usage due to evaluation of one argument does not clobber a register in which we
    already placed a previous argument (e.g. as the code generation logic for
    MO_Shl can clobber %rcx due to x86 instruction limitations).

    This is precisely what happened in #18527. Consider this C--:

        (result::I64) = call "ccall" doSomething(_s2hp::I64, 2244, _s2hq::I64, _s2hw::I64 | (1 << _s2hz::I64));

    Here we are calling the C function `doSomething` with three arguments, the last
    involving a non-trivial expression involving MO_Shl. In this case the NCG could
    naively generate the following assembly (where $tmp denotes some temporary
    register and $argN denotes the register for argument N, as dictated by the
    platform's calling convention):

        mov _s2hp, $arg1   # place first argument
        mov _s2hq, $arg2   # place second argument

        # Compute 1 << _s2hz
        mov _s2hz, %rcx
        shl %cl, $tmp

        # Compute (_s2hw | (1 << _s2hz))
        mov _s2hw, $arg3
        or $tmp, $arg3

        # Perform the call
        call func

    This code is outright broken on Windows which assigns $arg1 to %rcx. This means
    that the evaluation of the last argument clobbers the first argument.

    To avoid this we use a rather awful hack: when producing code for a C call with
    at least one non-trivial argument, we first evaluate all of the arguments into
    local registers before moving them into their final calling-convention-defined
    homes.  This is performed by 'evalArgs'. Here we define "non-trivial" to be an
    expression which might contain a MachOp since these are the only cases which
    might clobber registers. Furthermore, we use a conservative approximation of
    this condition (only looking at the top-level of CmmExprs) to avoid spending
    too much effort trying to decide whether we want to take the fast path.

    Note that this hack *also* applies to calls to out-of-line PrimTargets (which
    are lowered via a C call), which will ultimately end up in
    genForeignCall{32,64}.
    -}

    -- | See Note [Evaluate C-call arguments before placing in destination registers]
    evalArgs :: BlockId -> [CmmActual] -> NatM (InstrBlock, [CmmActual])
    evalArgs :: Label -> [CmmExpr] -> NatM (OrdList Instr, [CmmExpr])
    evalArgs Label
    bid [CmmExpr]
    actuals
      | (CmmExpr -> Bool) -> [CmmExpr] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any CmmExpr -> Bool
    mightContainMachOp [CmmExpr]
    actuals = do
          [(OrdList Instr, CmmExpr)]
    regs_blks <- (CmmExpr -> NatM (OrdList Instr, CmmExpr))
    -> [CmmExpr] -> NatM [(OrdList Instr, CmmExpr)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM CmmExpr -> NatM (OrdList Instr, CmmExpr)
    evalArg [CmmExpr]
    actuals
          (OrdList Instr, [CmmExpr]) -> NatM (OrdList Instr, [CmmExpr])
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([OrdList Instr] -> OrdList Instr
    forall a. [OrdList a] -> OrdList a
    concatOL ([OrdList Instr] -> OrdList Instr)
    -> [OrdList Instr] -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ ((OrdList Instr, CmmExpr) -> OrdList Instr)
    -> [(OrdList Instr, CmmExpr)] -> [OrdList Instr]
    forall a b. (a -> b) -> [a] -> [b]
    map (OrdList Instr, CmmExpr) -> OrdList Instr
    forall a b. (a, b) -> a
    fst [(OrdList Instr, CmmExpr)]
    regs_blks, ((OrdList Instr, CmmExpr) -> CmmExpr)
    -> [(OrdList Instr, CmmExpr)] -> [CmmExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map (OrdList Instr, CmmExpr) -> CmmExpr
    forall a b. (a, b) -> b
    snd [(OrdList Instr, CmmExpr)]
    regs_blks)
      | Bool
    otherwise = (OrdList Instr, [CmmExpr]) -> NatM (OrdList Instr, [CmmExpr])
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    forall a. OrdList a
    nilOL, [CmmExpr]
    actuals)
      where
        mightContainMachOp :: CmmExpr -> Bool
    mightContainMachOp (CmmReg CmmReg
    _)      = Bool
    False
        mightContainMachOp (CmmRegOff CmmReg
    _ Int
    _) = Bool
    False
        mightContainMachOp (CmmLit CmmLit
    _)      = Bool
    False
        mightContainMachOp CmmExpr
    _               = Bool
    True

        evalArg :: CmmActual -> NatM (InstrBlock, CmmExpr)
        evalArg :: CmmExpr -> NatM (OrdList Instr, CmmExpr)
    evalArg CmmExpr
    actual = do
            Platform
    platform <- NatM Platform
    getPlatform
            LocalReg
    lreg <- CmmType -> NatM LocalReg
    newLocalReg (CmmType -> NatM LocalReg) -> CmmType -> NatM LocalReg
    forall a b. (a -> b) -> a -> b
    $ Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    actual
            (OrdList Instr
    instrs, Maybe Label
    bid1) <- Label -> CmmNode O O -> NatM (OrdList Instr, Maybe Label)
    forall (e :: Extensibility) (x :: Extensibility).
    Label -> CmmNode e x -> NatM (OrdList Instr, Maybe Label)
    stmtToInstrs Label
    bid (CmmNode O O -> NatM (OrdList Instr, Maybe Label))
    -> CmmNode O O -> NatM (OrdList Instr, Maybe Label)
    forall a b. (a -> b) -> a -> b
    $ CmmReg -> CmmExpr -> CmmNode O O
    CmmAssign (LocalReg -> CmmReg
    CmmLocal LocalReg
    lreg) CmmExpr
    actual
            -- The above assignment shouldn't change the current block
            Bool -> NatM ()
    forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
    massert (Maybe Label -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe Label
    bid1)
            (OrdList Instr, CmmExpr) -> NatM (OrdList Instr, CmmExpr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    instrs, CmmReg -> CmmExpr
    CmmReg (CmmReg -> CmmExpr) -> CmmReg -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $ LocalReg -> CmmReg
    CmmLocal LocalReg
    lreg)

        newLocalReg :: CmmType -> NatM LocalReg
        newLocalReg :: CmmType -> NatM LocalReg
    newLocalReg CmmType
    ty = Unique -> CmmType -> LocalReg
    LocalReg (Unique -> CmmType -> LocalReg)
    -> NatM Unique -> NatM (CmmType -> LocalReg)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NatM Unique
    forall (m :: * -> *). MonadUnique m => m Unique
    getUniqueM NatM (CmmType -> LocalReg) -> NatM CmmType -> NatM LocalReg
    forall a b. NatM (a -> b) -> NatM a -> NatM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> CmmType -> NatM CmmType
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure CmmType
    ty

    -- Note [DIV/IDIV for bytes]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~
    -- IDIV reminder:
    --   Size    Dividend   Divisor   Quotient    Remainder
    --   byte    %ax         r/m8      %al          %ah
    --   word    %dx:%ax     r/m16     %ax          %dx
    --   dword   %edx:%eax   r/m32     %eax         %edx
    --   qword   %rdx:%rax   r/m64     %rax         %rdx
    --
    -- We do a special case for the byte division because the current
    -- codegen doesn't deal well with accessing %ah register (also,
    -- accessing %ah in 64-bit mode is complicated because it cannot be an
    -- operand of many instructions). So we just widen operands to 16 bits
    -- and get the results from %al, %dl. This is not optimal, but a few
    -- register moves are probably not a huge deal when doing division.

    -- | Generate C call to the given function in ghc-prim
    genPrimCCall
      :: BlockId
      -> FastString
      -> [CmmFormal]
      -> [CmmActual]
      -> NatM InstrBlock
    genPrimCCall :: Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genPrimCCall Label
    bid FastString
    lbl_txt [LocalReg]
    dsts [CmmExpr]
    args = do
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      -- FIXME: we should use mkForeignLabel instead of mkCmmCodeLabel
      let lbl :: CLabel
    lbl = UnitId -> FastString -> CLabel
    mkCmmCodeLabel UnitId
    primUnitId FastString
    lbl_txt
      CmmExpr
    addr <- NCGConfig -> ReferenceKind -> CLabel -> NatM CmmExpr
    forall (m :: * -> *).
    CmmMakeDynamicReferenceM m =>
    NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
    cmmMakeDynamicReference NCGConfig
    config ReferenceKind
    CallReference CLabel
    lbl
      let conv :: ForeignConvention
    conv = CCallConv
    -> [ForeignHint]
    -> [ForeignHint]
    -> CmmReturnInfo
    -> ForeignConvention
    ForeignConvention CCallConv
    CCallConv [] [] CmmReturnInfo
    CmmMayReturn
      Label
    -> CmmExpr
    -> ForeignConvention
    -> [LocalReg]
    -> [CmmExpr]
    -> NatM (OrdList Instr)
    genCCall Label
    bid CmmExpr
    addr ForeignConvention
    conv [LocalReg]
    dsts [CmmExpr]
    args

    -- | Generate C call to the given function in libc
    genLibCCall
      :: BlockId
      -> FastString
      -> [CmmFormal]
      -> [CmmActual]
      -> NatM InstrBlock
    genLibCCall :: Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid FastString
    lbl_txt [LocalReg]
    dsts [CmmExpr]
    args = do
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      -- Assume we can call these functions directly, and that they're not in a dynamic library.
      -- TODO: Why is this ok? Under linux this code will be in libm.so
      --       Is it because they're really implemented as a primitive instruction by the assembler??  -- BL 2009/12/31
      let lbl :: CLabel
    lbl = FastString
    -> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
    mkForeignLabel FastString
    lbl_txt Maybe Int
    forall a. Maybe a
    Nothing ForeignLabelSource
    ForeignLabelInThisPackage FunctionOrData
    IsFunction
      CmmExpr
    addr <- NCGConfig -> ReferenceKind -> CLabel -> NatM CmmExpr
    forall (m :: * -> *).
    CmmMakeDynamicReferenceM m =>
    NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
    cmmMakeDynamicReference NCGConfig
    config ReferenceKind
    CallReference CLabel
    lbl
      let conv :: ForeignConvention
    conv = CCallConv
    -> [ForeignHint]
    -> [ForeignHint]
    -> CmmReturnInfo
    -> ForeignConvention
    ForeignConvention CCallConv
    CCallConv [] [] CmmReturnInfo
    CmmMayReturn
      Label
    -> CmmExpr
    -> ForeignConvention
    -> [LocalReg]
    -> [CmmExpr]
    -> NatM (OrdList Instr)
    genCCall Label
    bid CmmExpr
    addr ForeignConvention
    conv [LocalReg]
    dsts [CmmExpr]
    args

    -- | Generate C call to the given function in the RTS
    genRTSCCall
      :: BlockId
      -> FastString
      -> [CmmFormal]
      -> [CmmActual]
      -> NatM InstrBlock
    genRTSCCall :: Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genRTSCCall Label
    bid FastString
    lbl_txt [LocalReg]
    dsts [CmmExpr]
    args = do
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      -- Assume we can call these functions directly, and that they're not in a dynamic library.
      let lbl :: CLabel
    lbl = FastString
    -> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
    mkForeignLabel FastString
    lbl_txt Maybe Int
    forall a. Maybe a
    Nothing ForeignLabelSource
    ForeignLabelInThisPackage FunctionOrData
    IsFunction
      CmmExpr
    addr <- NCGConfig -> ReferenceKind -> CLabel -> NatM CmmExpr
    forall (m :: * -> *).
    CmmMakeDynamicReferenceM m =>
    NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
    cmmMakeDynamicReference NCGConfig
    config ReferenceKind
    CallReference CLabel
    lbl
      let conv :: ForeignConvention
    conv = CCallConv
    -> [ForeignHint]
    -> [ForeignHint]
    -> CmmReturnInfo
    -> ForeignConvention
    ForeignConvention CCallConv
    CCallConv [] [] CmmReturnInfo
    CmmMayReturn
      Label
    -> CmmExpr
    -> ForeignConvention
    -> [LocalReg]
    -> [CmmExpr]
    -> NatM (OrdList Instr)
    genCCall Label
    bid CmmExpr
    addr ForeignConvention
    conv [LocalReg]
    dsts [CmmExpr]
    args

    -- | Generate a real C call to the given address with the given convention
    genCCall
      :: BlockId
      -> CmmExpr
      -> ForeignConvention
      -> [CmmFormal]
      -> [CmmActual]
      -> NatM InstrBlock
    genCCall :: Label
    -> CmmExpr
    -> ForeignConvention
    -> [LocalReg]
    -> [CmmExpr]
    -> NatM (OrdList Instr)
    genCCall Label
    bid CmmExpr
    addr ForeignConvention
    conv [LocalReg]
    dest_regs [CmmExpr]
    args = do
      Bool
    is32Bit <- NatM Bool
    is32BitPlatform
      (OrdList Instr
    instrs0, [CmmExpr]
    args') <- Label -> [CmmExpr] -> NatM (OrdList Instr, [CmmExpr])
    evalArgs Label
    bid [CmmExpr]
    args
      OrdList Instr
    instrs1 <- if Bool
    is32Bit
        then CmmExpr
    -> ForeignConvention
    -> [LocalReg]
    -> [CmmExpr]
    -> NatM (OrdList Instr)
    genCCall32 CmmExpr
    addr ForeignConvention
    conv [LocalReg]
    dest_regs [CmmExpr]
    args'
        else CmmExpr
    -> ForeignConvention
    -> [LocalReg]
    -> [CmmExpr]
    -> NatM (OrdList Instr)
    genCCall64 CmmExpr
    addr ForeignConvention
    conv [LocalReg]
    dest_regs [CmmExpr]
    args'
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    instrs0 OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    instrs1)

    genCCall32 :: CmmExpr           -- ^ address of the function to call
               -> ForeignConvention -- ^ calling convention
               -> [CmmFormal]       -- ^ where to put the result
               -> [CmmActual]       -- ^ arguments (of mixed type)
               -> NatM InstrBlock
    genCCall32 :: CmmExpr
    -> ForeignConvention
    -> [LocalReg]
    -> [CmmExpr]
    -> NatM (OrdList Instr)
    genCCall32 CmmExpr
    addr ForeignConvention
    conv [LocalReg]
    dest_regs [CmmExpr]
    args = do
            NCGConfig
    config <- NatM NCGConfig
    getConfig
            let platform :: Platform
    platform = NCGConfig -> Platform
    ncgPlatform NCGConfig
    config
                prom_args :: [CmmExpr]
    prom_args = (CmmExpr -> CmmExpr) -> [CmmExpr] -> [CmmExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> Width -> CmmExpr -> CmmExpr
    maybePromoteCArg Platform
    platform Width
    W32) [CmmExpr]
    args

                -- If the size is smaller than the word, we widen things (see maybePromoteCArg)
                arg_size_bytes :: CmmType -> Int
                arg_size_bytes :: CmmType -> Int
    arg_size_bytes CmmType
    ty = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max (Width -> Int
    widthInBytes (CmmType -> Width
    typeWidth CmmType
    ty)) (Width -> Int
    widthInBytes (Platform -> Width
    wordWidth Platform
    platform))

                roundTo :: a -> a -> a
    roundTo a
    a a
    x | a
    x a -> a -> a
    forall a. Integral a => a -> a -> a
    `mod` a
    a a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0 = a
    x
                            | Bool
    otherwise = a
    x a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    a a -> a -> a
    forall a. Num a => a -> a -> a
    - (a
    x a -> a -> a
    forall a. Integral a => a -> a -> a
    `mod` a
    a)

                push_arg :: CmmActual {-current argument-}
                                -> NatM InstrBlock  -- code

                push_arg :: CmmExpr -> NatM (OrdList Instr)
    push_arg  CmmExpr
    arg -- we don't need the hints on x86
                  | CmmType -> Bool
    isWord64 CmmType
    arg_ty = do
                    RegCode64 OrdList Instr
    code Reg
    r_hi Reg
    r_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    arg
                    Int
    delta <- NatM Int
    getDeltaNat
                    Int -> NatM ()
    setDeltaNat (Int
    delta Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    8)
                    OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (       OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                                   [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [Format -> Operand -> Instr
    PUSH Format
    II32 (Reg -> Operand
    OpReg Reg
    r_hi), Int -> Instr
    DELTA (Int
    delta Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    4),
                                         Format -> Operand -> Instr
    PUSH Format
    II32 (Reg -> Operand
    OpReg Reg
    r_lo), Int -> Instr
    DELTA (Int
    delta Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    8),
                                         Int -> Instr
    DELTA (Int
    deltaInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    8)]
                        )

                  | CmmType -> Bool
    isFloatType CmmType
    arg_ty = do
                    (Reg
    reg, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    arg
                    Int
    delta <- NatM Int
    getDeltaNat
                    Int -> NatM ()
    setDeltaNat (Int
    deltaInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    size)
                    OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                                    [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [Format -> Operand -> Operand -> Instr
    SUB Format
    II32 (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    size)) (Reg -> Operand
    OpReg Reg
    esp),
                                          Int -> Instr
    DELTA (Int
    deltaInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    size),
                                          let addr :: AddrMode
    addr = EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex (Reg -> EABase
    EABaseReg Reg
    esp)
                                                                    EAIndex
    EAIndexNone
                                                                    (Int -> Imm
    ImmInt Int
    0)
                                              format :: Format
    format = Width -> Format
    floatFormat (CmmType -> Width
    typeWidth CmmType
    arg_ty)
                                          in

                                          -- assume SSE2
                                           Format -> Operand -> Operand -> Instr
    MOV Format
    format (Reg -> Operand
    OpReg Reg
    reg) (AddrMode -> Operand
    OpAddr AddrMode
    addr)

                                         ]
                                   )

                  | Bool
    otherwise = do
                    -- Arguments can be smaller than 32-bit, but we still use @PUSH
                    -- II32@ - the usual calling conventions expect integers to be
                    -- 4-byte aligned.
                    Bool -> NatM ()
    forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
    massert ((CmmType -> Width
    typeWidth CmmType
    arg_ty) Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Width
    W32)
                    (Operand
    operand, OrdList Instr
    code) <- CmmExpr -> NatM (Operand, OrdList Instr)
    getOperand CmmExpr
    arg
                    Int
    delta <- NatM Int
    getDeltaNat
                    Int -> NatM ()
    setDeltaNat (Int
    deltaInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    size)
                    OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                            Format -> Operand -> Instr
    PUSH Format
    II32 Operand
    operand OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                            Int -> Instr
    DELTA (Int
    deltaInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    size))

                  where
                     arg_ty :: CmmType
    arg_ty = Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    arg
                     size :: Int
    size = CmmType -> Int
    arg_size_bytes CmmType
    arg_ty -- Byte size

            let
                -- Align stack to 16n for calls, assuming a starting stack
                -- alignment of 16n - word_size on procedure entry. Which we
                -- maintiain. See Note [Stack Alignment on X86] in rts/StgCRun.c.
                sizes :: [Int]
    sizes               = (CmmExpr -> Int) -> [CmmExpr] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (CmmType -> Int
    arg_size_bytes (CmmType -> Int) -> (CmmExpr -> CmmType) -> CmmExpr -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform) ([CmmExpr] -> [CmmExpr]
    forall a. [a] -> [a]
    reverse [CmmExpr]
    args)
                raw_arg_size :: Int
    raw_arg_size        = [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [Int]
    sizes Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Platform -> Int
    platformWordSizeInBytes Platform
    platform
                arg_pad_size :: Int
    arg_pad_size        = (Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    roundTo Int
    16 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int
    raw_arg_size) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    raw_arg_size
                tot_arg_size :: Int
    tot_arg_size        = Int
    raw_arg_size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    arg_pad_size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Platform -> Int
    platformWordSizeInBytes Platform
    platform

            Int
    delta0 <- NatM Int
    getDeltaNat
            Int -> NatM ()
    setDeltaNat (Int
    delta0 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    arg_pad_size)

            [OrdList Instr]
    push_codes <- (CmmExpr -> NatM (OrdList Instr))
    -> [CmmExpr] -> NatM [OrdList Instr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM CmmExpr -> NatM (OrdList Instr)
    push_arg ([CmmExpr] -> [CmmExpr]
    forall a. [a] -> [a]
    reverse [CmmExpr]
    prom_args)
            Int
    delta <- NatM Int
    getDeltaNat
            Bool -> NatM ()
    forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
    massert (Int
    delta Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    delta0 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    tot_arg_size)

            -- deal with static vs dynamic call targets
            (OrdList Instr
    callinsns,ForeignConvention
    cconv) <-
              case CmmExpr
    addr of
                CmmLit (CmmLabel CLabel
    lbl)
                   -> -- ToDo: stdcall arg sizes
                      (OrdList Instr, ForeignConvention)
    -> NatM (OrdList Instr, ForeignConvention)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Either Imm Reg -> [Reg] -> Instr
    CALL (Imm -> Either Imm Reg
    forall a b. a -> Either a b
    Left Imm
    fn_imm) []), ForeignConvention
    conv)
                   where fn_imm :: Imm
    fn_imm = CLabel -> Imm
    ImmCLbl CLabel
    lbl
                CmmExpr
    _
                   -> do { (Reg
    dyn_r, OrdList Instr
    dyn_c) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    addr
                         ; Bool -> NatM ()
    forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
    massert (CmmType -> Bool
    isWord32 (Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    addr))
                         ; (OrdList Instr, ForeignConvention)
    -> NatM (OrdList Instr, ForeignConvention)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    dyn_c OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Either Imm Reg -> [Reg] -> Instr
    CALL (Reg -> Either Imm Reg
    forall a b. b -> Either a b
    Right Reg
    dyn_r) [], ForeignConvention
    conv) }
            let push_code :: OrdList Instr
    push_code
                    | Int
    arg_pad_size Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0
                    = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [Format -> Operand -> Operand -> Instr
    SUB Format
    II32 (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    arg_pad_size)) (Reg -> Operand
    OpReg Reg
    esp),
                            Int -> Instr
    DELTA (Int
    delta0 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    arg_pad_size)]
                      OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [OrdList Instr] -> OrdList Instr
    forall a. [OrdList a] -> OrdList a
    concatOL [OrdList Instr]
    push_codes
                    | Bool
    otherwise
                    = [OrdList Instr] -> OrdList Instr
    forall a. [OrdList a] -> OrdList a
    concatOL [OrdList Instr]
    push_codes

                  -- Deallocate parameters after call for ccall;
                  -- but not for stdcall (callee does it)
                  --
                  -- We have to pop any stack padding we added
                  -- even if we are doing stdcall, though (#5052)
                pop_size :: Int
    pop_size
                   | ForeignConvention CCallConv
    StdCallConv [ForeignHint]
    _ [ForeignHint]
    _ CmmReturnInfo
    _ <- ForeignConvention
    cconv = Int
    arg_pad_size
                   | Bool
    otherwise = Int
    tot_arg_size

                call :: OrdList Instr
    call = OrdList Instr
    callinsns OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                       [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL (
                          (if Int
    pop_sizeInt -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    0 then [] else
                           [Format -> Operand -> Operand -> Instr
    ADD Format
    II32 (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    pop_size)) (Reg -> Operand
    OpReg Reg
    esp)])
                          [Instr] -> [Instr] -> [Instr]
    forall a. [a] -> [a] -> [a]
    ++
                          [Int -> Instr
    DELTA Int
    delta0]
                       )
            Int -> NatM ()
    setDeltaNat Int
    delta0

            let
                -- assign the results, if necessary
                assign_code :: [LocalReg] -> OrdList Instr
    assign_code []     = OrdList Instr
    forall a. OrdList a
    nilOL
                assign_code [LocalReg
    dest]
                  | CmmType -> Bool
    isFloatType CmmType
    ty =
                      -- we assume SSE2
                      let tmp_amode :: AddrMode
    tmp_amode = EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex (Reg -> EABase
    EABaseReg Reg
    esp)
                                                           EAIndex
    EAIndexNone
                                                           (Int -> Imm
    ImmInt Int
    0)
                          fmt :: Format
    fmt = Width -> Format
    floatFormat Width
    w
                             in [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Format -> Operand -> Operand -> Instr
    SUB Format
    II32 (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    b)) (Reg -> Operand
    OpReg Reg
    esp),
                                       Int -> Instr
    DELTA (Int
    delta0 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    b),
                                       Format -> AddrMode -> Instr
    X87Store Format
    fmt  AddrMode
    tmp_amode,
                                       -- X87Store only supported for the CDECL ABI
                                       -- NB: This code will need to be
                                       -- revisited once GHC does more work around
                                       -- SIGFPE f
                                       Format -> Operand -> Operand -> Instr
    MOV Format
    fmt (AddrMode -> Operand
    OpAddr AddrMode
    tmp_amode) (Reg -> Operand
    OpReg Reg
    r_dest),
                                       Format -> Operand -> Operand -> Instr
    ADD Format
    II32 (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    b)) (Reg -> Operand
    OpReg Reg
    esp),
                                       Int -> Instr
    DELTA Int
    delta0]
                  | CmmType -> Bool
    isWord64 CmmType
    ty    = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    eax) (Reg -> Operand
    OpReg Reg
    r_dest),
                                            Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    edx) (Reg -> Operand
    OpReg Reg
    r_dest_hi)]
                  | Bool
    otherwise      = Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV (Width -> Format
    intFormat Width
    w)
                                                 (Reg -> Operand
    OpReg Reg
    eax)
                                                 (Reg -> Operand
    OpReg Reg
    r_dest))
                  where
                        ty :: CmmType
    ty = LocalReg -> CmmType
    localRegType LocalReg
    dest
                        w :: Width
    w  = CmmType -> Width
    typeWidth CmmType
    ty
                        b :: Int
    b  = Width -> Int
    widthInBytes Width
    w
                        r_dest_hi :: Reg
    r_dest_hi = Reg -> Reg
    getHiVRegFromLo Reg
    r_dest
                        r_dest :: Reg
    r_dest    = LocalReg -> Reg
    getLocalRegReg LocalReg
    dest
                assign_code [LocalReg]
    many = String -> SDoc -> OrdList Instr
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "genForeignCall.assign_code - too many return values:" ([LocalReg] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [LocalReg]
    many)

            OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    push_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    OrdList Instr
    call OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    [LocalReg] -> OrdList Instr
    assign_code [LocalReg]
    dest_regs)

    genCCall64 :: CmmExpr           -- ^ address of function to call
               -> ForeignConvention -- ^ calling convention
               -> [CmmFormal]       -- ^ where to put the result
               -> [CmmActual]       -- ^ arguments (of mixed type)
               -> NatM InstrBlock
    genCCall64 :: CmmExpr
    -> ForeignConvention
    -> [LocalReg]
    -> [CmmExpr]
    -> NatM (OrdList Instr)
    genCCall64 CmmExpr
    addr ForeignConvention
    conv [LocalReg]
    dest_regs [CmmExpr]
    args = do
        Platform
    platform <- NatM Platform
    getPlatform
        -- load up the register arguments
        let prom_args :: [CmmExpr]
    prom_args = (CmmExpr -> CmmExpr) -> [CmmExpr] -> [CmmExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> Width -> CmmExpr -> CmmExpr
    maybePromoteCArg Platform
    platform Width
    W32) [CmmExpr]
    args

        let load_args :: [CmmExpr]
                      -> [Reg]         -- int regs avail for args
                      -> [Reg]         -- FP regs avail for args
                      -> InstrBlock    -- code computing args
                      -> InstrBlock    -- code assigning args to ABI regs
                      -> NatM ([CmmExpr],[Reg],[Reg],InstrBlock,InstrBlock)
            -- no more regs to use
            load_args :: [CmmExpr]
    -> [Reg]
    -> [Reg]
    -> OrdList Instr
    -> OrdList Instr
    -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    load_args [CmmExpr]
    args [] [] OrdList Instr
    code OrdList Instr
    acode     =
                ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CmmExpr]
    args, [], [], OrdList Instr
    code, OrdList Instr
    acode)

            -- no more args to push
            load_args [] [Reg]
    aregs [Reg]
    fregs OrdList Instr
    code OrdList Instr
    acode =
                ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [Reg]
    aregs, [Reg]
    fregs, OrdList Instr
    code, OrdList Instr
    acode)

            load_args (CmmExpr
    arg : [CmmExpr]
    rest) [Reg]
    aregs [Reg]
    fregs OrdList Instr
    code OrdList Instr
    acode
                | CmmType -> Bool
    isFloatType CmmType
    arg_rep = case [Reg]
    fregs of
                     []     -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    push_this_arg
                     (Reg
    r:[Reg]
    rs) -> do
                        (OrdList Instr
    code',OrdList Instr
    acode') <- Reg -> NatM (OrdList Instr, OrdList Instr)
    reg_this_arg Reg
    r
                        [CmmExpr]
    -> [Reg]
    -> [Reg]
    -> OrdList Instr
    -> OrdList Instr
    -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    load_args [CmmExpr]
    rest [Reg]
    aregs [Reg]
    rs OrdList Instr
    code' OrdList Instr
    acode'
                | Bool
    otherwise           = case [Reg]
    aregs of
                     []     -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    push_this_arg
                     (Reg
    r:[Reg]
    rs) -> do
                        (OrdList Instr
    code',OrdList Instr
    acode') <- Reg -> NatM (OrdList Instr, OrdList Instr)
    reg_this_arg Reg
    r
                        [CmmExpr]
    -> [Reg]
    -> [Reg]
    -> OrdList Instr
    -> OrdList Instr
    -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    load_args [CmmExpr]
    rest [Reg]
    rs [Reg]
    fregs OrdList Instr
    code' OrdList Instr
    acode'
                where

                  -- put arg into the list of stack pushed args
                  push_this_arg :: NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    push_this_arg = do
                     ([CmmExpr]
    args',[Reg]
    ars,[Reg]
    frs,OrdList Instr
    code',OrdList Instr
    acode')
                         <- [CmmExpr]
    -> [Reg]
    -> [Reg]
    -> OrdList Instr
    -> OrdList Instr
    -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    load_args [CmmExpr]
    rest [Reg]
    aregs [Reg]
    fregs OrdList Instr
    code OrdList Instr
    acode
                     ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmExpr
    argCmmExpr -> [CmmExpr] -> [CmmExpr]
    forall a. a -> [a] -> [a]
    :[CmmExpr]
    args', [Reg]
    ars, [Reg]
    frs, OrdList Instr
    code', OrdList Instr
    acode')

                  -- pass the arg into the given register
                  reg_this_arg :: Reg -> NatM (OrdList Instr, OrdList Instr)
    reg_this_arg Reg
    r
                    -- "operand" args can be directly assigned into r
                    | Platform -> CmmExpr -> Bool
    isOperand Platform
    platform CmmExpr
    arg = do
                        Reg -> OrdList Instr
    arg_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    arg
                        (OrdList Instr, OrdList Instr)
    -> NatM (OrdList Instr, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    code, (OrdList Instr
    acode OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> OrdList Instr
    arg_code Reg
    r))
                    -- The last non-operand arg can be directly assigned after its
                    -- computation without going into a temporary register
                    | (CmmExpr -> Bool) -> [CmmExpr] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Platform -> CmmExpr -> Bool
    isOperand Platform
    platform) [CmmExpr]
    rest = do
                        Reg -> OrdList Instr
    arg_code   <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    arg
                        (OrdList Instr, OrdList Instr)
    -> NatM (OrdList Instr, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> OrdList Instr
    arg_code Reg
    r,OrdList Instr
    acode)

                    -- other args need to be computed beforehand to avoid clobbering
                    -- previously assigned registers used to pass parameters (see
                    -- #11792, #12614). They are assigned into temporary registers
                    -- and get assigned to proper call ABI registers after they all
                    -- have been computed.
                    | Bool
    otherwise     = do
                        Reg -> OrdList Instr
    arg_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    arg
                        Reg
    tmp      <- Format -> NatM Reg
    getNewRegNat Format
    arg_fmt
                        let
                          code' :: OrdList Instr
    code'  = OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> OrdList Instr
    arg_code Reg
    tmp
                          acode' :: OrdList Instr
    acode' = OrdList Instr
    acode OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> Reg -> Instr
    reg2reg Format
    arg_fmt Reg
    tmp Reg
    r
                        (OrdList Instr, OrdList Instr)
    -> NatM (OrdList Instr, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    code',OrdList Instr
    acode')

                  arg_rep :: CmmType
    arg_rep = Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    arg
                  arg_fmt :: Format
    arg_fmt = CmmType -> Format
    cmmTypeFormat CmmType
    arg_rep

            load_args_win :: [CmmExpr]
                          -> [Reg]        -- used int regs
                          -> [Reg]        -- used FP regs
                          -> [(Reg, Reg)] -- (int, FP) regs avail for args
                          -> InstrBlock
                          -> NatM ([CmmExpr],[Reg],[Reg],InstrBlock,InstrBlock)
            load_args_win :: [CmmExpr]
    -> [Reg]
    -> [Reg]
    -> [(Reg, Reg)]
    -> OrdList Instr
    -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    load_args_win [CmmExpr]
    args [Reg]
    usedInt [Reg]
    usedFP [] OrdList Instr
    code
                = ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CmmExpr]
    args, [Reg]
    usedInt, [Reg]
    usedFP, OrdList Instr
    code, OrdList Instr
    forall a. OrdList a
    nilOL)
                -- no more regs to use
            load_args_win [] [Reg]
    usedInt [Reg]
    usedFP [(Reg, Reg)]
    _ OrdList Instr
    code
                = ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [Reg]
    usedInt, [Reg]
    usedFP, OrdList Instr
    code, OrdList Instr
    forall a. OrdList a
    nilOL)
                -- no more args to push
            load_args_win (CmmExpr
    arg : [CmmExpr]
    rest) [Reg]
    usedInt [Reg]
    usedFP
                          ((Reg
    ireg, Reg
    freg) : [(Reg, Reg)]
    regs) OrdList Instr
    code
                | CmmType -> Bool
    isFloatType CmmType
    arg_rep = do
                     Reg -> OrdList Instr
    arg_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    arg
                     [CmmExpr]
    -> [Reg]
    -> [Reg]
    -> [(Reg, Reg)]
    -> OrdList Instr
    -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    load_args_win [CmmExpr]
    rest (Reg
    ireg Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : [Reg]
    usedInt) (Reg
    freg Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : [Reg]
    usedFP) [(Reg, Reg)]
    regs
                                   (OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                                    Reg -> OrdList Instr
    arg_code Reg
    freg OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                    -- If we are calling a varargs function
                                    -- then we need to define ireg as well
                                    -- as freg
                                    Format -> Operand -> Operand -> Instr
    MOV Format
    II64 (Reg -> Operand
    OpReg Reg
    freg) (Reg -> Operand
    OpReg Reg
    ireg))
                | Bool
    otherwise = do
                     Reg -> OrdList Instr
    arg_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    arg
                     [CmmExpr]
    -> [Reg]
    -> [Reg]
    -> [(Reg, Reg)]
    -> OrdList Instr
    -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    load_args_win [CmmExpr]
    rest (Reg
    ireg Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : [Reg]
    usedInt) [Reg]
    usedFP [(Reg, Reg)]
    regs
                                   (OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> OrdList Instr
    arg_code Reg
    ireg)
                where
                  arg_rep :: CmmType
    arg_rep = Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    arg

            arg_size :: Int
    arg_size = Int
    8 -- always, at the mo

            push_args :: [CmmExpr] -> OrdList Instr -> NatM (OrdList Instr)
    push_args [] OrdList Instr
    code = OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    code
            push_args (CmmExpr
    arg:[CmmExpr]
    rest) OrdList Instr
    code
               | CmmType -> Bool
    isFloatType CmmType
    arg_rep = do
                 (Reg
    arg_reg, OrdList Instr
    arg_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    arg
                 Int
    delta <- NatM Int
    getDeltaNat
                 Int -> NatM ()
    setDeltaNat (Int
    deltaInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    arg_size)
                 let code' :: OrdList Instr
    code' = OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    arg_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                                Format -> Operand -> Operand -> Instr
    SUB (Width -> Format
    intFormat (Platform -> Width
    wordWidth Platform
    platform)) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    arg_size)) (Reg -> Operand
    OpReg Reg
    rsp),
                                Int -> Instr
    DELTA (Int
    deltaInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    arg_size),
                                Format -> Operand -> Operand -> Instr
    MOV (Width -> Format
    floatFormat Width
    width) (Reg -> Operand
    OpReg Reg
    arg_reg) (AddrMode -> Operand
    OpAddr (Platform -> Int -> AddrMode
    spRel Platform
    platform Int
    0))]
                 [CmmExpr] -> OrdList Instr -> NatM (OrdList Instr)
    push_args [CmmExpr]
    rest OrdList Instr
    code'

               | Bool
    otherwise = do
                 -- Arguments can be smaller than 64-bit, but we still use @PUSH
                 -- II64@ - the usual calling conventions expect integers to be
                 -- 8-byte aligned.
                 Bool -> NatM ()
    forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
    massert (Width
    width Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Width
    W64)
                 (Operand
    arg_op, OrdList Instr
    arg_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
    getOperand CmmExpr
    arg
                 Int
    delta <- NatM Int
    getDeltaNat
                 Int -> NatM ()
    setDeltaNat (Int
    deltaInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    arg_size)
                 let code' :: OrdList Instr
    code' = OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    arg_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                                        Format -> Operand -> Instr
    PUSH Format
    II64 Operand
    arg_op,
                                        Int -> Instr
    DELTA (Int
    deltaInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    arg_size)]
                 [CmmExpr] -> OrdList Instr -> NatM (OrdList Instr)
    push_args [CmmExpr]
    rest OrdList Instr
    code'
                where
                  arg_rep :: CmmType
    arg_rep = Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    arg
                  width :: Width
    width = CmmType -> Width
    typeWidth CmmType
    arg_rep

            leaveStackSpace :: Int -> NatM (OrdList Instr)
    leaveStackSpace Int
    n = do
                 Int
    delta <- NatM Int
    getDeltaNat
                 Int -> NatM ()
    setDeltaNat (Int
    delta Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    arg_size)
                 OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                             Format -> Operand -> Operand -> Instr
    SUB Format
    II64 (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Platform -> Int
    platformWordSizeInBytes Platform
    platform))) (Reg -> Operand
    OpReg Reg
    rsp),
                             Int -> Instr
    DELTA (Int
    delta Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    arg_size)]

        ([CmmExpr]
    stack_args, [Reg]
    int_regs_used, [Reg]
    fp_regs_used, OrdList Instr
    load_args_code, OrdList Instr
    assign_args_code)
             <-
            if Platform -> OS
    platformOS Platform
    platform OS -> OS -> Bool
    forall a. Eq a => a -> a -> Bool
    == OS
    OSMinGW32
            then [CmmExpr]
    -> [Reg]
    -> [Reg]
    -> [(Reg, Reg)]
    -> OrdList Instr
    -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    load_args_win [CmmExpr]
    prom_args [] [] (Platform -> [(Reg, Reg)]
    allArgRegs Platform
    platform) OrdList Instr
    forall a. OrdList a
    nilOL
            else do
               ([CmmExpr]
    stack_args, [Reg]
    aregs, [Reg]
    fregs, OrdList Instr
    load_args_code, OrdList Instr
    assign_args_code)
                   <- [CmmExpr]
    -> [Reg]
    -> [Reg]
    -> OrdList Instr
    -> OrdList Instr
    -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    load_args [CmmExpr]
    prom_args (Platform -> [Reg]
    allIntArgRegs Platform
    platform)
                                          (Platform -> [Reg]
    allFPArgRegs Platform
    platform)
                                          OrdList Instr
    forall a. OrdList a
    nilOL OrdList Instr
    forall a. OrdList a
    nilOL
               let used_regs :: t a -> [a] -> [a]
    used_regs t a
    rs [a]
    as = [a] -> [a]
    forall a. [a] -> [a]
    reverse (Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    drop (t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    rs) ([a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    as))
                   fregs_used :: [Reg]
    fregs_used      = [Reg] -> [Reg] -> [Reg]
    forall {t :: * -> *} {a} {a}. Foldable t => t a -> [a] -> [a]
    used_regs [Reg]
    fregs (Platform -> [Reg]
    allFPArgRegs Platform
    platform)
                   aregs_used :: [Reg]
    aregs_used      = [Reg] -> [Reg] -> [Reg]
    forall {t :: * -> *} {a} {a}. Foldable t => t a -> [a] -> [a]
    used_regs [Reg]
    aregs (Platform -> [Reg]
    allIntArgRegs Platform
    platform)
               ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    -> NatM ([CmmExpr], [Reg], [Reg], OrdList Instr, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CmmExpr]
    stack_args, [Reg]
    aregs_used, [Reg]
    fregs_used, OrdList Instr
    load_args_code
                                                          , OrdList Instr
    assign_args_code)

        let
            arg_regs_used :: [Reg]
    arg_regs_used = [Reg]
    int_regs_used [Reg] -> [Reg] -> [Reg]
    forall a. [a] -> [a] -> [a]
    ++ [Reg]
    fp_regs_used
            arg_regs :: [Reg]
    arg_regs = [Reg
    eax] [Reg] -> [Reg] -> [Reg]
    forall a. [a] -> [a] -> [a]
    ++ [Reg]
    arg_regs_used
                    -- for annotating the call instruction with
            sse_regs :: Int
    sse_regs = [Reg] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Reg]
    fp_regs_used
            arg_stack_slots :: Int
    arg_stack_slots = if Platform -> OS
    platformOS Platform
    platform OS -> OS -> Bool
    forall a. Eq a => a -> a -> Bool
    == OS
    OSMinGW32
                              then [CmmExpr] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CmmExpr]
    stack_args Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [(Reg, Reg)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Platform -> [(Reg, Reg)]
    allArgRegs Platform
    platform)
                              else [CmmExpr] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CmmExpr]
    stack_args
            tot_arg_size :: Int
    tot_arg_size = Int
    arg_size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    arg_stack_slots

        -- Align stack to 16n for calls, assuming a starting stack
        -- alignment of 16n - word_size on procedure entry. Which we
        -- maintain. See Note [Stack Alignment on X86] in rts/StgCRun.c
        let word_size :: Int
    word_size = Platform -> Int
    platformWordSizeInBytes Platform
    platform
        (Int
    real_size, OrdList Instr
    adjust_rsp) <-
            if (Int
    tot_arg_size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    word_size) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `rem` Int
    16 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0
                then (Int, OrdList Instr) -> NatM (Int, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    tot_arg_size, OrdList Instr
    forall a. OrdList a
    nilOL)
                else do -- we need to adjust...
                    Int
    delta <- NatM Int
    getDeltaNat
                    Int -> NatM ()
    setDeltaNat (Int
    delta Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    word_size)
                    (Int, OrdList Instr) -> NatM (Int, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    tot_arg_size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    word_size, [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                                    Format -> Operand -> Operand -> Instr
    SUB Format
    II64 (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    word_size)) (Reg -> Operand
    OpReg Reg
    rsp),
                                    Int -> Instr
    DELTA (Int
    delta Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    word_size) ])

        -- push the stack args, right to left
        OrdList Instr
    push_code <- [CmmExpr] -> OrdList Instr -> NatM (OrdList Instr)
    push_args ([CmmExpr] -> [CmmExpr]
    forall a. [a] -> [a]
    reverse [CmmExpr]
    stack_args) OrdList Instr
    forall a. OrdList a
    nilOL
        -- On Win64, we also have to leave stack space for the arguments
        -- that we are passing in registers
        OrdList Instr
    lss_code <- if Platform -> OS
    platformOS Platform
    platform OS -> OS -> Bool
    forall a. Eq a => a -> a -> Bool
    == OS
    OSMinGW32
                    then Int -> NatM (OrdList Instr)
    leaveStackSpace ([(Reg, Reg)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Platform -> [(Reg, Reg)]
    allArgRegs Platform
    platform))
                    else OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    forall a. OrdList a
    nilOL
        Int
    delta <- NatM Int
    getDeltaNat

        -- deal with static vs dynamic call targets
        (OrdList Instr
    callinsns,ForeignConvention
    _cconv) <- case CmmExpr
    addr of
          CmmLit (CmmLabel CLabel
    lbl) ->
            -- ToDo: stdcall arg sizes
            (OrdList Instr, ForeignConvention)
    -> NatM (OrdList Instr, ForeignConvention)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Either Imm Reg -> [Reg] -> Instr
    CALL (Imm -> Either Imm Reg
    forall a b. a -> Either a b
    Left (CLabel -> Imm
    ImmCLbl CLabel
    lbl)) [Reg]
    arg_regs), ForeignConvention
    conv)
          CmmExpr
    _ -> do
            (Reg
    dyn_r, OrdList Instr
    dyn_c) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    addr
            (OrdList Instr, ForeignConvention)
    -> NatM (OrdList Instr, ForeignConvention)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    dyn_c OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Either Imm Reg -> [Reg] -> Instr
    CALL (Reg -> Either Imm Reg
    forall a b. b -> Either a b
    Right Reg
    dyn_r) [Reg]
    arg_regs, ForeignConvention
    conv)

        let
            -- The x86_64 ABI requires us to set %al to the number of SSE2
            -- registers that contain arguments, if the called routine
            -- is a varargs function.  We don't know whether it's a
            -- varargs function or not, so we have to assume it is.
            --
            -- It's not safe to omit this assignment, even if the number
            -- of SSE2 regs in use is zero.  If %al is larger than 8
            -- on entry to a varargs function, seg faults ensue.
            assign_eax :: Int -> OrdList Instr
    assign_eax Int
    n = Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    n)) (Reg -> Operand
    OpReg Reg
    eax))

        let call :: OrdList Instr
    call = OrdList Instr
    callinsns OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                   [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL (
                        -- Deallocate parameters after call for ccall;
                        -- stdcall has callee do it, but is not supported on
                        -- x86_64 target (see #3336)
                      (if Int
    real_sizeInt -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    0 then [] else
                       [Format -> Operand -> Operand -> Instr
    ADD (Width -> Format
    intFormat (Platform -> Width
    platformWordWidth Platform
    platform)) (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    real_size)) (Reg -> Operand
    OpReg Reg
    esp)])
                      [Instr] -> [Instr] -> [Instr]
    forall a. [a] -> [a] -> [a]
    ++
                      [Int -> Instr
    DELTA (Int
    delta Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    real_size)]
                   )
        Int -> NatM ()
    setDeltaNat (Int
    delta Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    real_size)

        let
            -- assign the results, if necessary
            assign_code :: [LocalReg] -> OrdList Instr
    assign_code []     = OrdList Instr
    forall a. OrdList a
    nilOL
            assign_code [LocalReg
    dest] =
              case CmmType -> Width
    typeWidth CmmType
    rep of
                    Width
    W32 | CmmType -> Bool
    isFloatType CmmType
    rep -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV (Width -> Format
    floatFormat Width
    W32)
                                                         (Reg -> Operand
    OpReg Reg
    xmm0)
                                                         (Reg -> Operand
    OpReg Reg
    r_dest))
                    Width
    W64 | CmmType -> Bool
    isFloatType CmmType
    rep -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV (Width -> Format
    floatFormat Width
    W64)
                                                         (Reg -> Operand
    OpReg Reg
    xmm0)
                                                         (Reg -> Operand
    OpReg Reg
    r_dest))
                    Width
    _ -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV (CmmType -> Format
    cmmTypeFormat CmmType
    rep) (Reg -> Operand
    OpReg Reg
    rax) (Reg -> Operand
    OpReg Reg
    r_dest))
              where
                    rep :: CmmType
    rep = LocalReg -> CmmType
    localRegType LocalReg
    dest
                    r_dest :: Reg
    r_dest = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform  (LocalReg -> CmmReg
    CmmLocal LocalReg
    dest)
            assign_code [LocalReg]
    _many = String -> OrdList Instr
    forall a. String -> a
    panic String
    "genForeignCall.assign_code many"

        OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    adjust_rsp          OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                OrdList Instr
    push_code           OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                OrdList Instr
    load_args_code      OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                OrdList Instr
    assign_args_code    OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                OrdList Instr
    lss_code            OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                Int -> OrdList Instr
    assign_eax Int
    sse_regs OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                OrdList Instr
    call                OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                [LocalReg] -> OrdList Instr
    assign_code [LocalReg]
    dest_regs)

    maybePromoteCArg :: Platform -> Width -> CmmExpr -> CmmExpr
    maybePromoteCArg :: Platform -> Width -> CmmExpr -> CmmExpr
    maybePromoteCArg Platform
    platform Width
    wto CmmExpr
    arg
     | Width
    wfrom Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    < Width
    wto = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> Width -> MachOp
    MO_UU_Conv Width
    wfrom Width
    wto) [CmmExpr
    arg]
     | Bool
    otherwise   = CmmExpr
    arg
     where
       wfrom :: Width
    wfrom = Platform -> CmmExpr -> Width
    cmmExprWidth Platform
    platform CmmExpr
    arg

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

    {-
    Note [Sub-word subtlety during jump-table indexing]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Offset the index by the start index of the jump table.
    It's important that we do this *before* the widening below. To see
    why, consider a switch with a sub-word, signed discriminant such as:

        switch [-5...+2] x::I16 {
            case -5: ...
            ...
            case +2: ...
        }

    Consider what happens if we offset *after* widening in the case that
    x=-4:

                                             // x == -4 == 0xfffc::I16
        indexWidened = UU_Conv(x);           // == 0xfffc::I64
        indexExpr    = indexWidened - (-5);  // == 0x10000::I64

    This index is clearly nonsense given that the jump table only has
    eight entries.

    By contrast, if we widen *after* we offset then we get the correct
    index (1),

                                             // x == -4 == 0xfffc::I16
        indexOffset  = x - (-5);             // == 1::I16
        indexExpr    = UU_Conv(indexOffset); // == 1::I64

    See #21186.
    -}

    genSwitch :: CmmExpr -> SwitchTargets -> NatM InstrBlock

    genSwitch :: CmmExpr -> SwitchTargets -> NatM (OrdList Instr)
    genSwitch CmmExpr
    expr SwitchTargets
    targets = do
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      let platform :: Platform
    platform = NCGConfig -> Platform
    ncgPlatform NCGConfig
    config
          expr_w :: Width
    expr_w = Platform -> CmmExpr -> Width
    cmmExprWidth Platform
    platform CmmExpr
    expr
          indexExpr0 :: CmmExpr
    indexExpr0 = Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffset Platform
    platform CmmExpr
    expr Int
    offset
          -- We widen to a native-width register because we cannot use arbitrary sizes
          -- in x86 addressing modes.
          -- See Note [Sub-word subtlety during jump-table indexing].
          indexExpr :: CmmExpr
    indexExpr = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp
            (Width -> Width -> MachOp
    MO_UU_Conv Width
    expr_w (Platform -> Width
    platformWordWidth Platform
    platform))
            [CmmExpr
    indexExpr0]
      if NCGConfig -> Bool
    ncgPIC NCGConfig
    config
      then do
            (Reg
    reg,OrdList Instr
    e_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getNonClobberedReg CmmExpr
    indexExpr
               -- getNonClobberedReg because it needs to survive across t_code
            CLabel
    lbl <- NatM CLabel
    getNewLabelNat
            let is32bit :: Bool
    is32bit = Platform -> Bool
    target32Bit Platform
    platform
                os :: OS
    os = Platform -> OS
    platformOS Platform
    platform
                -- Might want to use .rodata.<function we're in> instead, but as
                -- long as it's something unique it'll work out since the
                -- references to the jump table are in the appropriate section.
                rosection :: Section
    rosection = case OS
    os of
                  -- on Mac OS X/x86_64, put the jump table in the text section to
                  -- work around a limitation of the linker.
                  -- ld64 is unable to handle the relocations for
                  --     .quad L1 - L0
                  -- if L0 is not preceded by a non-anonymous label in its section.
                  OS
    OSDarwin | Bool -> Bool
    not Bool
    is32bit -> SectionType -> CLabel -> Section
    Section SectionType
    Text CLabel
    lbl
                  OS
    _ -> SectionType -> CLabel -> Section
    Section SectionType
    ReadOnlyData CLabel
    lbl
            CmmExpr
    dynRef <- NCGConfig -> ReferenceKind -> CLabel -> NatM CmmExpr
    forall (m :: * -> *).
    CmmMakeDynamicReferenceM m =>
    NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
    cmmMakeDynamicReference NCGConfig
    config ReferenceKind
    DataReference CLabel
    lbl
            (Reg
    tableReg,OrdList Instr
    t_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (CmmExpr -> NatM (Reg, OrdList Instr))
    -> CmmExpr -> NatM (Reg, OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ CmmExpr
    dynRef
            let op :: Operand
    op = AddrMode -> Operand
    OpAddr (EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex (Reg -> EABase
    EABaseReg Reg
    tableReg)
                                           (Reg -> Int -> EAIndex
    EAIndex Reg
    reg (Platform -> Int
    platformWordSizeInBytes Platform
    platform)) (Int -> Imm
    ImmInt Int
    0))

            Reg
    offsetReg <- Format -> NatM Reg
    getNewRegNat (Width -> Format
    intFormat (Platform -> Width
    platformWordWidth Platform
    platform))
            OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ if Bool
    is32bit Bool -> Bool -> Bool
    || OS
    os OS -> OS -> Bool
    forall a. Eq a => a -> a -> Bool
    == OS
    OSDarwin
                     then OrdList Instr
    e_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    t_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                                    Format -> Operand -> Operand -> Instr
    ADD (Width -> Format
    intFormat (Platform -> Width
    platformWordWidth Platform
    platform)) Operand
    op (Reg -> Operand
    OpReg Reg
    tableReg),
                                    Operand -> [Maybe JumpDest] -> Section -> CLabel -> Instr
    JMP_TBL (Reg -> Operand
    OpReg Reg
    tableReg) [Maybe JumpDest]
    ids Section
    rosection CLabel
    lbl
                           ]
                     else -- HACK: On x86_64 binutils<2.17 is only able to generate
                          -- PC32 relocations, hence we only get 32-bit offsets in
                          -- the jump table. As these offsets are always negative
                          -- we need to properly sign extend them to 64-bit. This
                          -- hack should be removed in conjunction with the hack in
                          -- PprMach.hs/pprDataItem once binutils 2.17 is standard.
                          OrdList Instr
    e_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    t_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                                   Format -> Operand -> Operand -> Instr
    MOVSxL Format
    II32 Operand
    op (Reg -> Operand
    OpReg Reg
    offsetReg),
                                   Format -> Operand -> Operand -> Instr
    ADD (Width -> Format
    intFormat (Platform -> Width
    platformWordWidth Platform
    platform))
                                       (Reg -> Operand
    OpReg Reg
    offsetReg)
                                       (Reg -> Operand
    OpReg Reg
    tableReg),
                                   Operand -> [Maybe JumpDest] -> Section -> CLabel -> Instr
    JMP_TBL (Reg -> Operand
    OpReg Reg
    tableReg) [Maybe JumpDest]
    ids Section
    rosection CLabel
    lbl
                           ]
      else do
            (Reg
    reg,OrdList Instr
    e_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    indexExpr
            CLabel
    lbl <- NatM CLabel
    getNewLabelNat
            let is32bit :: Bool
    is32bit = Platform -> Bool
    target32Bit Platform
    platform
            if Bool
    is32bit
              then let op :: Operand
    op = AddrMode -> Operand
    OpAddr (EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex EABase
    EABaseNone (Reg -> Int -> EAIndex
    EAIndex Reg
    reg (Platform -> Int
    platformWordSizeInBytes Platform
    platform)) (CLabel -> Imm
    ImmCLbl CLabel
    lbl))
                       jmp_code :: Instr
    jmp_code = Operand -> [Maybe JumpDest] -> Section -> CLabel -> Instr
    JMP_TBL Operand
    op [Maybe JumpDest]
    ids (SectionType -> CLabel -> Section
    Section SectionType
    ReadOnlyData CLabel
    lbl) CLabel
    lbl
                   in OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    e_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL Instr
    jmp_code
              else do
                -- See Note [%rip-relative addressing on x86-64].
                Reg
    tableReg <- Format -> NatM Reg
    getNewRegNat (Width -> Format
    intFormat (Platform -> Width
    platformWordWidth Platform
    platform))
                let op :: Operand
    op = AddrMode -> Operand
    OpAddr (EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex (Reg -> EABase
    EABaseReg Reg
    tableReg) (Reg -> Int -> EAIndex
    EAIndex Reg
    reg (Platform -> Int
    platformWordSizeInBytes Platform
    platform)) (Int -> Imm
    ImmInt Int
    0))
                    code :: OrdList Instr
    code = OrdList Instr
    e_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                        [ Format -> Operand -> Operand -> Instr
    LEA (Bool -> Format
    archWordFormat Bool
    is32bit) (AddrMode -> Operand
    OpAddr (EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex EABase
    EABaseRip EAIndex
    EAIndexNone (CLabel -> Imm
    ImmCLbl CLabel
    lbl))) (Reg -> Operand
    OpReg Reg
    tableReg)
                        , Format -> Operand -> Operand -> Instr
    MOV (Bool -> Format
    archWordFormat Bool
    is32bit) Operand
    op (Reg -> Operand
    OpReg Reg
    reg)
                        , Operand -> [Maybe JumpDest] -> Section -> CLabel -> Instr
    JMP_TBL (Reg -> Operand
    OpReg Reg
    reg) [Maybe JumpDest]
    ids (SectionType -> CLabel -> Section
    Section SectionType
    ReadOnlyData CLabel
    lbl) CLabel
    lbl
                        ]
                OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    code
      where
        (Int
    offset, [Maybe Label]
    blockIds) = SwitchTargets -> (Int, [Maybe Label])
    switchTargetsToTable SwitchTargets
    targets
        ids :: [Maybe JumpDest]
    ids = (Maybe Label -> Maybe JumpDest)
    -> [Maybe Label] -> [Maybe JumpDest]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Label -> JumpDest) -> Maybe Label -> Maybe JumpDest
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Label -> JumpDest
    DestBlockId) [Maybe Label]
    blockIds

    generateJumpTableForInstr :: NCGConfig -> Instr -> Maybe (NatCmmDecl (Alignment, RawCmmStatics) Instr)
    generateJumpTableForInstr :: NCGConfig
    -> Instr -> Maybe (NatCmmDecl (Alignment, RawCmmStatics) Instr)
    generateJumpTableForInstr NCGConfig
    config (JMP_TBL Operand
    _ [Maybe JumpDest]
    ids Section
    section CLabel
    lbl)
        = let getBlockId :: JumpDest -> Label
    getBlockId (DestBlockId Label
    id) = Label
    id
              getBlockId JumpDest
    _ = String -> Label
    forall a. String -> a
    panic String
    "Non-Label target in Jump Table"
              blockIds :: [Maybe Label]
    blockIds = (Maybe JumpDest -> Maybe Label)
    -> [Maybe JumpDest] -> [Maybe Label]
    forall a b. (a -> b) -> [a] -> [b]
    map ((JumpDest -> Label) -> Maybe JumpDest -> Maybe Label
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap JumpDest -> Label
    getBlockId) [Maybe JumpDest]
    ids
          in NatCmmDecl (Alignment, RawCmmStatics) Instr
    -> Maybe (NatCmmDecl (Alignment, RawCmmStatics) Instr)
    forall a. a -> Maybe a
    Just (NCGConfig
    -> [Maybe Label]
    -> Section
    -> CLabel
    -> NatCmmDecl (Alignment, RawCmmStatics) Instr
    forall h g.
    NCGConfig
    -> [Maybe Label]
    -> Section
    -> CLabel
    -> GenCmmDecl (Alignment, RawCmmStatics) h g
    createJumpTable NCGConfig
    config [Maybe Label]
    blockIds Section
    section CLabel
    lbl)
    generateJumpTableForInstr NCGConfig
    _ Instr
    _ = Maybe (NatCmmDecl (Alignment, RawCmmStatics) Instr)
    forall a. Maybe a
    Nothing

    createJumpTable :: NCGConfig -> [Maybe BlockId] -> Section -> CLabel
                    -> GenCmmDecl (Alignment, RawCmmStatics) h g
    createJumpTable :: forall h g.
    NCGConfig
    -> [Maybe Label]
    -> Section
    -> CLabel
    -> GenCmmDecl (Alignment, RawCmmStatics) h g
    createJumpTable NCGConfig
    config [Maybe Label]
    ids Section
    section CLabel
    lbl
        = let jumpTable :: [CmmStatic]
    jumpTable
                | NCGConfig -> Bool
    ncgPIC NCGConfig
    config =
                      let ww :: Width
    ww = NCGConfig -> Width
    ncgWordWidth NCGConfig
    config
                          jumpTableEntryRel :: Maybe Label -> CmmStatic
    jumpTableEntryRel Maybe Label
    Nothing
                              = CmmLit -> CmmStatic
    CmmStaticLit (Integer -> Width -> CmmLit
    CmmInt Integer
    0 Width
    ww)
                          jumpTableEntryRel (Just Label
    blockid)
                              = CmmLit -> CmmStatic
    CmmStaticLit (CLabel -> CLabel -> Int -> Width -> CmmLit
    CmmLabelDiffOff CLabel
    blockLabel CLabel
    lbl Int
    0 Width
    ww)
                              where blockLabel :: CLabel
    blockLabel = Label -> CLabel
    blockLbl Label
    blockid
                      in (Maybe Label -> CmmStatic) -> [Maybe Label] -> [CmmStatic]
    forall a b. (a -> b) -> [a] -> [b]
    map Maybe Label -> CmmStatic
    jumpTableEntryRel [Maybe Label]
    ids
                | Bool
    otherwise = (Maybe Label -> CmmStatic) -> [Maybe Label] -> [CmmStatic]
    forall a b. (a -> b) -> [a] -> [b]
    map (NCGConfig -> Maybe Label -> CmmStatic
    jumpTableEntry NCGConfig
    config) [Maybe Label]
    ids
          in Section
    -> (Alignment, RawCmmStatics)
    -> GenCmmDecl (Alignment, RawCmmStatics) h g
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData Section
    section (Int -> Alignment
    mkAlignment Int
    1, CLabel -> [CmmStatic] -> RawCmmStatics
    forall (rawOnly :: Bool).
    CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
    CmmStaticsRaw CLabel
    lbl [CmmStatic]
    jumpTable)

    extractUnwindPoints :: [Instr] -> [UnwindPoint]
    extractUnwindPoints :: [Instr] -> [UnwindPoint]
    extractUnwindPoints [Instr]
    instrs =
        [ CLabel -> Map GlobalReg (Maybe UnwindExpr) -> UnwindPoint
    UnwindPoint CLabel
    lbl Map GlobalReg (Maybe UnwindExpr)
    unwinds | UNWIND CLabel
    lbl Map GlobalReg (Maybe UnwindExpr)
    unwinds <- [Instr]
    instrs]

    -- -----------------------------------------------------------------------------
    -- 'condIntReg' and 'condFltReg': condition codes into registers

    -- Turn those condition codes into integers now (when they appear on
    -- the right hand side of an assignment).
    --
    -- (If applicable) Do not fill the delay slots here; you will confuse the
    -- register allocator.

    condIntReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register

    condIntReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
    condIntReg Cond
    cond CmmExpr
    x CmmExpr
    y = do
      CondCode Bool
    _ Cond
    cond OrdList Instr
    cond_code <- Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode Cond
    cond CmmExpr
    x CmmExpr
    y
      Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    II8
      let
            code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    cond_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                        Cond -> Operand -> Instr
    SETCC Cond
    cond (Reg -> Operand
    OpReg Reg
    tmp),
                        Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II8 (Reg -> Operand
    OpReg Reg
    tmp) (Reg -> Operand
    OpReg Reg
    dst)
                      ]
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II32 Reg -> OrdList Instr
    code)

    -- Note [SSE Parity Checks]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~
    -- We have to worry about unordered operands (eg. comparisons
    -- against NaN).  If the operands are unordered, the comparison
    -- sets the parity flag, carry flag and zero flag.
    -- All comparisons are supposed to return false for unordered
    -- operands except for !=, which returns true.
    --
    -- Optimisation: we don't have to test the parity flag if we
    -- know the test has already excluded the unordered case: eg >
    -- and >= test for a zero carry flag, which can only occur for
    -- ordered operands.
    --
    -- By reversing comparisons we can avoid testing the parity
    -- for < and <= as well. If any of the arguments is an NaN we
    -- return false either way. If both arguments are valid then
    -- x <= y  <->  y >= x  holds. So it's safe to swap these.
    --
    -- We invert the condition inside getRegister'and  getCondCode
    -- which should cover all invertable cases.
    -- All other functions translating FP comparisons to assembly
    -- use these to two generate the comparison code.
    --
    -- As an example consider a simple check:
    --
    -- func :: Float -> Float -> Int
    -- func x y = if x < y then 1 else 0
    --
    -- Which in Cmm gives the floating point comparison.
    --
    --  if (%MO_F_Lt_W32(F1, F2)) goto c2gg; else goto c2gf;
    --
    -- We used to compile this to an assembly code block like this:
    -- _c2gh:
    --  ucomiss %xmm2,%xmm1
    --  jp _c2gf
    --  jb _c2gg
    --  jmp _c2gf
    --
    -- Where we have to introduce an explicit
    -- check for unordered results (using jmp parity):
    --
    -- We can avoid this by exchanging the arguments and inverting the direction
    -- of the comparison. This results in the sequence of:
    --
    --  ucomiss %xmm1,%xmm2
    --  ja _c2g2
    --  jmp _c2g1
    --
    -- Removing the jump reduces the pressure on the branch predidiction system
    -- and plays better with the uOP cache.

    condFltReg :: Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg :: Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg Bool
    is32Bit Cond
    cond CmmExpr
    x CmmExpr
    y = NatM Register
    condFltReg_sse2
     where

      condFltReg_sse2 :: NatM Register
    condFltReg_sse2 = do
        CondCode Bool
    _ Cond
    cond OrdList Instr
    cond_code <- Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    cond CmmExpr
    x CmmExpr
    y
        Reg
    tmp1 <- Format -> NatM Reg
    getNewRegNat (Bool -> Format
    archWordFormat Bool
    is32Bit)
        Reg
    tmp2 <- Format -> NatM Reg
    getNewRegNat (Bool -> Format
    archWordFormat Bool
    is32Bit)
        let -- See Note [SSE Parity Checks]
            code :: Reg -> OrdList Instr
    code Reg
    dst =
               OrdList Instr
    cond_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                 (case Cond
    cond of
                    Cond
    NE  -> Reg -> OrdList Instr
    or_unordered Reg
    dst
                    Cond
    GU  -> Reg -> OrdList Instr
    plain_test   Reg
    dst
                    Cond
    GEU -> Reg -> OrdList Instr
    plain_test   Reg
    dst
                    -- Use ASSERT so we don't break releases if these creep in.
                    Cond
    LTT -> Bool -> SDoc -> OrdList Instr -> OrdList Instr
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr Bool
    False (String -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr String
    "Should have been turned into >") (OrdList Instr -> OrdList Instr) -> OrdList Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $
                           Reg -> OrdList Instr
    and_ordered  Reg
    dst
                    Cond
    LE  -> Bool -> SDoc -> OrdList Instr -> OrdList Instr
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr Bool
    False (String -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr String
    "Should have been turned into >=") (OrdList Instr -> OrdList Instr) -> OrdList Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $
                           Reg -> OrdList Instr
    and_ordered  Reg
    dst
                    Cond
    _   -> Reg -> OrdList Instr
    and_ordered  Reg
    dst)

            plain_test :: Reg -> OrdList Instr
    plain_test Reg
    dst = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                        Cond -> Operand -> Instr
    SETCC Cond
    cond (Reg -> Operand
    OpReg Reg
    tmp1),
                        Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II8 (Reg -> Operand
    OpReg Reg
    tmp1) (Reg -> Operand
    OpReg Reg
    dst)
                     ]
            or_unordered :: Reg -> OrdList Instr
    or_unordered Reg
    dst = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                        Cond -> Operand -> Instr
    SETCC Cond
    cond (Reg -> Operand
    OpReg Reg
    tmp1),
                        Cond -> Operand -> Instr
    SETCC Cond
    PARITY (Reg -> Operand
    OpReg Reg
    tmp2),
                        Format -> Operand -> Operand -> Instr
    OR Format
    II8 (Reg -> Operand
    OpReg Reg
    tmp1) (Reg -> Operand
    OpReg Reg
    tmp2),
                        Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II8 (Reg -> Operand
    OpReg Reg
    tmp2) (Reg -> Operand
    OpReg Reg
    dst)
                      ]
            and_ordered :: Reg -> OrdList Instr
    and_ordered Reg
    dst = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                        Cond -> Operand -> Instr
    SETCC Cond
    cond (Reg -> Operand
    OpReg Reg
    tmp1),
                        Cond -> Operand -> Instr
    SETCC Cond
    NOTPARITY (Reg -> Operand
    OpReg Reg
    tmp2),
                        Format -> Operand -> Operand -> Instr
    AND Format
    II8 (Reg -> Operand
    OpReg Reg
    tmp1) (Reg -> Operand
    OpReg Reg
    tmp2),
                        Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II8 (Reg -> Operand
    OpReg Reg
    tmp2) (Reg -> Operand
    OpReg Reg
    dst)
                      ]
        Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II32 Reg -> OrdList Instr
    code)

    -- -----------------------------------------------------------------------------
    -- 'trivial*Code': deal with trivial instructions

    -- Trivial (dyadic: 'trivialCode', floating-point: 'trivialFCode',
    -- unary: 'trivialUCode', unary fl-pt:'trivialUFCode') instructions.
    -- Only look for constants on the right hand side, because that's
    -- where the generic optimizer will have put them.

    -- Similarly, for unary instructions, we don't have to worry about
    -- matching an StInt as the argument, because genericOpt will already
    -- have handled the constant-folding.

    {-
    The Rules of the Game are:

    * You cannot assume anything about the destination register dst;
      it may be anything, including a fixed reg.

    * You may compute an operand into a fixed reg, but you may not
      subsequently change the contents of that fixed reg.  If you
      want to do so, first copy the value either to a temporary
      or into dst.  You are free to modify dst even if it happens
      to be a fixed reg -- that's not your problem.

    * You cannot assume that a fixed reg will stay live over an
      arbitrary computation.  The same applies to the dst reg.

    * Temporary regs obtained from getNewRegNat are distinct from
      each other and from all other regs, and stay live over
      arbitrary computations.

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

    SDM's version of The Rules:

    * If getRegister returns Any, that means it can generate correct
      code which places the result in any register, period.  Even if that
      register happens to be read during the computation.

      Corollary #1: this means that if you are generating code for an
      operation with two arbitrary operands, you cannot assign the result
      of the first operand into the destination register before computing
      the second operand.  The second operand might require the old value
      of the destination register.

      Corollary #2: A function might be able to generate more efficient
      code if it knows the destination register is a new temporary (and
      therefore not read by any of the sub-computations).

    * If getRegister returns Any, then the code it generates may modify only:
            (a) fresh temporaries
            (b) the destination register
            (c) known registers (eg. %ecx is used by shifts)
      In particular, it may *not* modify global registers, unless the global
      register happens to be the destination register.
    -}

    trivialCode :: Width -> (Operand -> Operand -> Instr)
                -> Maybe (Operand -> Operand -> Instr)
                -> CmmExpr -> CmmExpr -> NatM Register
    trivialCode :: Width
    -> (Operand -> Operand -> Instr)
    -> Maybe (Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    width Operand -> Operand -> Instr
    instr Maybe (Operand -> Operand -> Instr)
    m CmmExpr
    a CmmExpr
    b
        = do Platform
    platform <- NatM Platform
    getPlatform
             Platform
    -> Width
    -> (Operand -> Operand -> Instr)
    -> Maybe (Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode' Platform
    platform Width
    width Operand -> Operand -> Instr
    instr Maybe (Operand -> Operand -> Instr)
    m CmmExpr
    a CmmExpr
    b

    trivialCode' :: Platform -> Width -> (Operand -> Operand -> Instr)
                 -> Maybe (Operand -> Operand -> Instr)
                 -> CmmExpr -> CmmExpr -> NatM Register
    trivialCode' :: Platform
    -> Width
    -> (Operand -> Operand -> Instr)
    -> Maybe (Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode' Platform
    platform Width
    width Operand -> Operand -> Instr
    _ (Just Operand -> Operand -> Instr
    revinstr) (CmmLit CmmLit
    lit_a) CmmExpr
    b
      | Platform -> CmmLit -> Bool
    is32BitLit Platform
    platform CmmLit
    lit_a = do
      Reg -> OrdList Instr
    b_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    b
      let
           code :: Reg -> OrdList Instr
    code Reg
    dst
             = Reg -> OrdList Instr
    b_code Reg
    dst OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
               Operand -> Operand -> Instr
    revinstr (Imm -> Operand
    OpImm (CmmLit -> Imm
    litToImm CmmLit
    lit_a)) (Reg -> Operand
    OpReg Reg
    dst)
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    width) Reg -> OrdList Instr
    code)

    trivialCode' Platform
    _ Width
    width Operand -> Operand -> Instr
    instr Maybe (Operand -> Operand -> Instr)
    _ CmmExpr
    a CmmExpr
    b
      = Format
    -> (Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    genTrivialCode (Width -> Format
    intFormat Width
    width) Operand -> Operand -> Instr
    instr CmmExpr
    a CmmExpr
    b

    -- This is re-used for floating pt instructions too.
    genTrivialCode :: Format -> (Operand -> Operand -> Instr)
                   -> CmmExpr -> CmmExpr -> NatM Register
    genTrivialCode :: Format
    -> (Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    genTrivialCode Format
    rep Operand -> Operand -> Instr
    instr CmmExpr
    a CmmExpr
    b = do
      (Operand
    b_op, OrdList Instr
    b_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
    getNonClobberedOperand CmmExpr
    b
      Reg -> OrdList Instr
    a_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    a
      Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    rep
      let
         -- We want the value of b to stay alive across the computation of a.
         -- But, we want to calculate a straight into the destination register,
         -- because the instruction only has two operands (dst := dst `op` src).
         -- The troublesome case is when the result of b is in the same register
         -- as the destination reg.  In this case, we have to save b in a
         -- new temporary across the computation of a.
         code :: Reg -> OrdList Instr
    code Reg
    dst
            | Reg
    dst Reg -> Operand -> Bool
    `regClashesWithOp` Operand
    b_op =
                    OrdList Instr
    b_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV Format
    rep Operand
    b_op (Reg -> Operand
    OpReg Reg
    tmp)) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    Reg -> OrdList Instr
    a_code Reg
    dst OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                    Operand -> Operand -> Instr
    instr (Reg -> Operand
    OpReg Reg
    tmp) (Reg -> Operand
    OpReg Reg
    dst)
            | Bool
    otherwise =
                    OrdList Instr
    b_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    Reg -> OrdList Instr
    a_code Reg
    dst OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                    Operand -> Operand -> Instr
    instr Operand
    b_op (Reg -> Operand
    OpReg Reg
    dst)
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    rep Reg -> OrdList Instr
    code)

    regClashesWithOp :: Reg -> Operand -> Bool
    Reg
    reg regClashesWithOp :: Reg -> Operand -> Bool
    `regClashesWithOp` OpReg Reg
    reg2   = Reg
    reg Reg -> Reg -> Bool
    forall a. Eq a => a -> a -> Bool
    == Reg
    reg2
    Reg
    reg `regClashesWithOp` OpAddr AddrMode
    amode = (Reg -> Bool) -> [Reg] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Reg -> Reg -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Reg
    reg) (AddrMode -> [Reg]
    addrModeRegs AddrMode
    amode)
    Reg
    _   `regClashesWithOp` Operand
    _            = Bool
    False

    -----------

    trivialUCode :: Format -> (Operand -> Instr)
                 -> CmmExpr -> NatM Register
    trivialUCode :: Format -> (Operand -> Instr) -> CmmExpr -> NatM Register
    trivialUCode Format
    rep Operand -> Instr
    instr CmmExpr
    x = do
      Reg -> OrdList Instr
    x_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    x
      let
         code :: Reg -> OrdList Instr
    code Reg
    dst =
            Reg -> OrdList Instr
    x_code Reg
    dst OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
            Operand -> Instr
    instr (Reg -> Operand
    OpReg Reg
    dst)
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    rep Reg -> OrdList Instr
    code)

    -----------

    trivialFCode_sse2 :: Width -> (Format -> Operand -> Operand -> Instr)
                      -> CmmExpr -> CmmExpr -> NatM Register
    trivialFCode_sse2 :: Width
    -> (Format -> Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialFCode_sse2 Width
    pk Format -> Operand -> Operand -> Instr
    instr CmmExpr
    x CmmExpr
    y
        = Format
    -> (Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    genTrivialCode Format
    format (Format -> Operand -> Operand -> Instr
    instr Format
    format) CmmExpr
    x CmmExpr
    y
        where format :: Format
    format = Width -> Format
    floatFormat Width
    pk

    --------------------------------------------------------------------------------
    coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
    coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
    coerceInt2FP Width
    from Width
    to CmmExpr
    x =  NatM Register
    coerce_sse2
     where

       coerce_sse2 :: NatM Register
    coerce_sse2 = do
         (Operand
    x_op, OrdList Instr
    x_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
    getOperand CmmExpr
    x  -- ToDo: could be a safe operand
         let
               opc :: Format -> Operand -> Reg -> Instr
    opc  = case Width
    to of Width
    W32 -> Format -> Operand -> Reg -> Instr
    CVTSI2SS; Width
    W64 -> Format -> Operand -> Reg -> Instr
    CVTSI2SD
                                 Width
    n -> String -> Format -> Operand -> Reg -> Instr
    forall a. String -> a
    panic (String -> Format -> Operand -> Reg -> Instr)
    -> String -> Format -> Operand -> Reg -> Instr
    forall a b. (a -> b) -> a -> b
    $ String
    "coerceInt2FP.sse: unhandled width ("
                                             String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Width -> String
    forall a. Show a => a -> String
    show Width
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
               code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    x_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Operand -> Reg -> Instr
    opc (Width -> Format
    intFormat Width
    from) Operand
    x_op Reg
    dst
         Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    floatFormat Width
    to) Reg -> OrdList Instr
    code)
            -- works even if the destination rep is <II32

    --------------------------------------------------------------------------------
    coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
    coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
    coerceFP2Int Width
    from Width
    to CmmExpr
    x =  NatM Register
    coerceFP2Int_sse2
     where
       coerceFP2Int_sse2 :: NatM Register
    coerceFP2Int_sse2 = do
         (Operand
    x_op, OrdList Instr
    x_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
    getOperand CmmExpr
    x  -- ToDo: could be a safe operand
         let
               opc :: Format -> Operand -> Reg -> Instr
    opc  = case Width
    from of Width
    W32 -> Format -> Operand -> Reg -> Instr
    CVTTSS2SIQ; Width
    W64 -> Format -> Operand -> Reg -> Instr
    CVTTSD2SIQ;
                                   Width
    n -> String -> Format -> Operand -> Reg -> Instr
    forall a. String -> a
    panic (String -> Format -> Operand -> Reg -> Instr)
    -> String -> Format -> Operand -> Reg -> Instr
    forall a b. (a -> b) -> a -> b
    $ String
    "coerceFP2Init.sse: unhandled width ("
                                               String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Width -> String
    forall a. Show a => a -> String
    show Width
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
               code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    x_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Operand -> Reg -> Instr
    opc (Width -> Format
    intFormat Width
    to) Operand
    x_op Reg
    dst
         Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    to) Reg -> OrdList Instr
    code)
             -- works even if the destination rep is <II32

    --------------------------------------------------------------------------------
    coerceFP2FP :: Width -> CmmExpr -> NatM Register
    coerceFP2FP :: Width -> CmmExpr -> NatM Register
    coerceFP2FP Width
    to CmmExpr
    x = do
      (Reg
    x_reg, OrdList Instr
    x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
      let
            opc :: Reg -> Reg -> Instr
    opc  = case Width
    to of Width
    W32 -> Reg -> Reg -> Instr
    CVTSD2SS; Width
    W64 -> Reg -> Reg -> Instr
    CVTSS2SD;
                                         Width
    n -> String -> Reg -> Reg -> Instr
    forall a. String -> a
    panic (String -> Reg -> Reg -> Instr) -> String -> Reg -> Reg -> Instr
    forall a b. (a -> b) -> a -> b
    $ String
    "coerceFP2FP: unhandled width ("
                                                     String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Width -> String
    forall a. Show a => a -> String
    show Width
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
            code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    x_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Instr
    opc Reg
    x_reg Reg
    dst
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any ( Width -> Format
    floatFormat Width
    to) Reg -> OrdList Instr
    code)

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

    sse2NegCode :: Width -> CmmExpr -> NatM Register
    sse2NegCode :: Width -> CmmExpr -> NatM Register
    sse2NegCode Width
    w CmmExpr
    x = do
      let fmt :: Format
    fmt = Width -> Format
    floatFormat Width
    w
      Reg -> OrdList Instr
    x_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    x
      -- This is how gcc does it, so it can't be that bad:
      let
        const :: CmmLit
    const = case Format
    fmt of
          Format
    FF32 -> Integer -> Width -> CmmLit
    CmmInt Integer
    0x80000000 Width
    W32
          Format
    FF64 -> Integer -> Width -> CmmLit
    CmmInt Integer
    0x8000000000000000 Width
    W64
          x :: Format
    x@Format
    II8  -> Format -> CmmLit
    forall {a} {a}. Show a => a -> a
    wrongFmt Format
    x
          x :: Format
    x@Format
    II16 -> Format -> CmmLit
    forall {a} {a}. Show a => a -> a
    wrongFmt Format
    x
          x :: Format
    x@Format
    II32 -> Format -> CmmLit
    forall {a} {a}. Show a => a -> a
    wrongFmt Format
    x
          x :: Format
    x@Format
    II64 -> Format -> CmmLit
    forall {a} {a}. Show a => a -> a
    wrongFmt Format
    x

          where
            wrongFmt :: a -> a
    wrongFmt a
    x = String -> a
    forall a. String -> a
    panic (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ String
    "sse2NegCode: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    x
      Amode AddrMode
    amode OrdList Instr
    amode_code <- Alignment -> CmmLit -> NatM Amode
    memConstant (Int -> Alignment
    mkAlignment (Int -> Alignment) -> Int -> Alignment
    forall a b. (a -> b) -> a -> b
    $ Width -> Int
    widthInBytes Width
    w) CmmLit
    const
      Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    fmt
      let
        code :: Reg -> OrdList Instr
    code Reg
    dst = Reg -> OrdList Instr
    x_code Reg
    dst OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    amode_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
            Format -> Operand -> Operand -> Instr
    MOV Format
    fmt (AddrMode -> Operand
    OpAddr AddrMode
    amode) (Reg -> Operand
    OpReg Reg
    tmp),
            Format -> Operand -> Operand -> Instr
    XOR Format
    fmt (Reg -> Operand
    OpReg Reg
    tmp) (Reg -> Operand
    OpReg Reg
    dst)
            ]
      --
      Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    fmt Reg -> OrdList Instr
    code)

    isVecExpr :: CmmExpr -> Bool
    isVecExpr :: CmmExpr -> Bool
    isVecExpr (CmmMachOp (MO_V_Insert {}) [CmmExpr]
    _)   = Bool
    True
    isVecExpr (CmmMachOp (MO_V_Extract {}) [CmmExpr]
    _)  = Bool
    True
    isVecExpr (CmmMachOp (MO_V_Add {}) [CmmExpr]
    _)      = Bool
    True
    isVecExpr (CmmMachOp (MO_V_Sub {}) [CmmExpr]
    _)      = Bool
    True
    isVecExpr (CmmMachOp (MO_V_Mul {}) [CmmExpr]
    _)      = Bool
    True
    isVecExpr (CmmMachOp (MO_VS_Quot {}) [CmmExpr]
    _)    = Bool
    True
    isVecExpr (CmmMachOp (MO_VS_Rem {}) [CmmExpr]
    _)     = Bool
    True
    isVecExpr (CmmMachOp (MO_VS_Neg {}) [CmmExpr]
    _)     = Bool
    True
    isVecExpr (CmmMachOp (MO_VF_Insert {}) [CmmExpr]
    _)  = Bool
    True
    isVecExpr (CmmMachOp (MO_VF_Extract {}) [CmmExpr]
    _) = Bool
    True
    isVecExpr (CmmMachOp (MO_VF_Add {}) [CmmExpr]
    _)     = Bool
    True
    isVecExpr (CmmMachOp (MO_VF_Sub {}) [CmmExpr]
    _)     = Bool
    True
    isVecExpr (CmmMachOp (MO_VF_Mul {}) [CmmExpr]
    _)     = Bool
    True
    isVecExpr (CmmMachOp (MO_VF_Quot {}) [CmmExpr]
    _)    = Bool
    True
    isVecExpr (CmmMachOp (MO_VF_Neg {}) [CmmExpr]
    _)     = Bool
    True
    isVecExpr (CmmMachOp MachOp
    _ [CmmExpr
    e])                = CmmExpr -> Bool
    isVecExpr CmmExpr
    e
    isVecExpr CmmExpr
    _                                = Bool
    False

    needLlvm :: NatM a
    needLlvm :: forall a. NatM a
    needLlvm =
        String -> NatM a
    forall a. String -> a
    sorry (String -> NatM a) -> String -> NatM a
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines [String
    "The native code generator does not support vector"
                        ,String
    "instructions. Please use -fllvm."]

    -- | This works on the invariant that all jumps in the given blocks are required.
    --   Starting from there we try to make a few more jumps redundant by reordering
    --   them.
    --   We depend on the information in the CFG to do so so without a given CFG
    --   we do nothing.
    invertCondBranches :: Maybe CFG  -- ^ CFG if present
                       -> LabelMap a -- ^ Blocks with info tables
                       -> [NatBasicBlock Instr] -- ^ List of basic blocks
                       -> [NatBasicBlock Instr]
    invertCondBranches :: forall a.
    Maybe CFG
    -> LabelMap a -> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
    invertCondBranches Maybe CFG
    Nothing LabelMap a
    _       [NatBasicBlock Instr]
    bs = [NatBasicBlock Instr]
    bs
    invertCondBranches (Just CFG
    cfg) LabelMap a
    keep [NatBasicBlock Instr]
    bs =
        [NatBasicBlock Instr] -> [NatBasicBlock Instr]
    invert [NatBasicBlock Instr]
    bs
      where
        invert :: [NatBasicBlock Instr] -> [NatBasicBlock Instr]
        invert :: [NatBasicBlock Instr] -> [NatBasicBlock Instr]
    invert ((BasicBlock Label
    lbl1 ins :: [Instr]
    ins@(Instr
    _:Instr
    _:[Instr]
    _xs)):b2 :: NatBasicBlock Instr
    b2@(BasicBlock Label
    lbl2 [Instr]
    _):[NatBasicBlock Instr]
    bs)
          | --pprTrace "Block" (ppr lbl1) True,
            (Instr
    jmp1,Instr
    jmp2) <- [Instr] -> (Instr, Instr)
    forall a. [a] -> (a, a)
    last2 [Instr]
    ins
          , JXX Cond
    cond1 Label
    target1 <- Instr
    jmp1
          , Label
    target1 Label -> Label -> Bool
    forall a. Eq a => a -> a -> Bool
    == Label
    lbl2
          --, pprTrace "CutChance" (ppr b1) True
          , JXX Cond
    ALWAYS Label
    target2 <- Instr
    jmp2
          -- We have enough information to check if we can perform the inversion
          -- TODO: We could also check for the last asm instruction which sets
          -- status flags instead. Which I suspect is worse in terms of compiler
          -- performance, but might be applicable to more cases
          , Just EdgeInfo
    edgeInfo1 <- Label -> Label -> CFG -> Maybe EdgeInfo
    getEdgeInfo Label
    lbl1 Label
    target1 CFG
    cfg
          , Just EdgeInfo
    edgeInfo2 <- Label -> Label -> CFG -> Maybe EdgeInfo
    getEdgeInfo Label
    lbl1 Label
    target2 CFG
    cfg
          -- Both jumps come from the same cmm statement
          , EdgeInfo -> TransitionSource
    transitionSource EdgeInfo
    edgeInfo1 TransitionSource -> TransitionSource -> Bool
    forall a. Eq a => a -> a -> Bool
    == EdgeInfo -> TransitionSource
    transitionSource EdgeInfo
    edgeInfo2
          , CmmSource {trans_cmmNode :: TransitionSource -> CmmNode O C
    trans_cmmNode = CmmNode O C
    cmmCondBranch} <- EdgeInfo -> TransitionSource
    transitionSource EdgeInfo
    edgeInfo1

          --Int comparisons are invertable
          , CmmCondBranch (CmmMachOp MachOp
    op [CmmExpr]
    _args) Label
    _ Label
    _ Maybe Bool
    _ <- CmmNode O C
    cmmCondBranch
          , Just Width
    _ <- MachOp -> Maybe Width
    maybeIntComparison MachOp
    op
          , Just Cond
    invCond <- Cond -> Maybe Cond
    maybeInvertCond Cond
    cond1

          --Swap the last two jumps, invert the conditional jumps condition.
          = let jumps :: [Instr]
    jumps =
                  case () of
                    -- We are free the eliminate the jmp. So we do so.
                    ()
    _ | Bool -> Bool
    not (KeyOf LabelMap -> LabelMap a -> Bool
    forall a. KeyOf LabelMap -> LabelMap a -> Bool
    forall (map :: * -> *) a. IsMap map => KeyOf map -> map a -> Bool
    mapMember KeyOf LabelMap
    Label
    target1 LabelMap a
    keep)
                        -> [Cond -> Label -> Instr
    JXX Cond
    invCond Label
    target2]
                    -- If the conditional target is unlikely we put the other
                    -- target at the front.
                      | EdgeInfo -> EdgeWeight
    edgeWeight EdgeInfo
    edgeInfo2 EdgeWeight -> EdgeWeight -> Bool
    forall a. Ord a => a -> a -> Bool
    > EdgeInfo -> EdgeWeight
    edgeWeight EdgeInfo
    edgeInfo1
                        -> [Cond -> Label -> Instr
    JXX Cond
    invCond Label
    target2, Cond -> Label -> Instr
    JXX Cond
    ALWAYS Label
    target1]
                    -- Keep things as-is otherwise
                      | Bool
    otherwise
                        -> [Instr
    jmp1, Instr
    jmp2]
            in --pprTrace "Cutable" (ppr [jmp1,jmp2] <+> text "=>" <+> ppr jumps) $
               (Label -> [Instr] -> NatBasicBlock Instr
    forall i. Label -> [i] -> GenBasicBlock i
    BasicBlock Label
    lbl1
                (Int -> [Instr] -> [Instr]
    forall a. Int -> [a] -> [a]
    dropTail Int
    2 [Instr]
    ins [Instr] -> [Instr] -> [Instr]
    forall a. [a] -> [a] -> [a]
    ++ [Instr]
    jumps))
                NatBasicBlock Instr
    -> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
    forall a. a -> [a] -> [a]
    : [NatBasicBlock Instr] -> [NatBasicBlock Instr]
    invert (NatBasicBlock Instr
    b2NatBasicBlock Instr
    -> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
    forall a. a -> [a] -> [a]
    :[NatBasicBlock Instr]
    bs)
        invert (NatBasicBlock Instr
    b:[NatBasicBlock Instr]
    bs) = NatBasicBlock Instr
    b NatBasicBlock Instr
    -> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
    forall a. a -> [a] -> [a]
    : [NatBasicBlock Instr] -> [NatBasicBlock Instr]
    invert [NatBasicBlock Instr]
    bs
        invert [] = []

    genAtomicRMW
      :: BlockId
      -> Width
      -> AtomicMachOp
      -> LocalReg
      -> CmmExpr
      -> CmmExpr
      -> NatM (InstrBlock, Maybe BlockId)
    genAtomicRMW :: Label
    -> Width
    -> AtomicMachOp
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr, Maybe Label)
    genAtomicRMW Label
    bid Width
    width AtomicMachOp
    amop LocalReg
    dst CmmExpr
    addr CmmExpr
    n = do
        Amode AddrMode
    amode OrdList Instr
    addr_code <-
            if AtomicMachOp
    amop AtomicMachOp -> [AtomicMachOp] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [AtomicMachOp
    AMO_Add, AtomicMachOp
    AMO_Sub]
            then CmmExpr -> NatM Amode
    getAmode CmmExpr
    addr
            else CmmExpr -> NatM Amode
    getSimpleAmode CmmExpr
    addr  -- See genForeignCall for MO_Cmpxchg
        Reg
    arg <- Format -> NatM Reg
    getNewRegNat Format
    format
        Reg -> OrdList Instr
    arg_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    n
        Platform
    platform <- NCGConfig -> Platform
    ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NatM NCGConfig
    getConfig

        let dst_r :: Reg
    dst_r    = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform  (LocalReg -> CmmReg
    CmmLocal LocalReg
    dst)
        (OrdList Instr
    code, Label
    lbl) <- Reg -> Reg -> AddrMode -> NatM (OrdList Instr, Label)
    op_code Reg
    dst_r Reg
    arg AddrMode
    amode
        (OrdList Instr, Maybe Label) -> NatM (OrdList Instr, Maybe Label)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    addr_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> OrdList Instr
    arg_code Reg
    arg OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code, Label -> Maybe Label
    forall a. a -> Maybe a
    Just Label
    lbl)
      where
        -- Code for the operation
        op_code :: Reg       -- Destination reg
                -> Reg       -- Register containing argument
                -> AddrMode  -- Address of location to mutate
                -> NatM (OrdList Instr,BlockId) -- TODO: Return Maybe BlockId
        op_code :: Reg -> Reg -> AddrMode -> NatM (OrdList Instr, Label)
    op_code Reg
    dst_r Reg
    arg AddrMode
    amode = case AtomicMachOp
    amop of
            -- In the common case where dst_r is a virtual register the
            -- final move should go away, because it's the last use of arg
            -- and the first use of dst_r.
            AtomicMachOp
    AMO_Add  -> (OrdList Instr, Label) -> NatM (OrdList Instr, Label)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((OrdList Instr, Label) -> NatM (OrdList Instr, Label))
    -> (OrdList Instr, Label) -> NatM (OrdList Instr, Label)
    forall a b. (a -> b) -> a -> b
    $ ([Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Instr -> Instr
    LOCK (Format -> Operand -> Operand -> Instr
    XADD Format
    format (Reg -> Operand
    OpReg Reg
    arg) (AddrMode -> Operand
    OpAddr AddrMode
    amode))
                                       , Format -> Operand -> Operand -> Instr
    MOV Format
    format (Reg -> Operand
    OpReg Reg
    arg) (Reg -> Operand
    OpReg Reg
    dst_r)
                                       ], Label
    bid)
            AtomicMachOp
    AMO_Sub  -> (OrdList Instr, Label) -> NatM (OrdList Instr, Label)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((OrdList Instr, Label) -> NatM (OrdList Instr, Label))
    -> (OrdList Instr, Label) -> NatM (OrdList Instr, Label)
    forall a b. (a -> b) -> a -> b
    $ ([Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Format -> Operand -> Instr
    NEGI Format
    format (Reg -> Operand
    OpReg Reg
    arg)
                                       , Instr -> Instr
    LOCK (Format -> Operand -> Operand -> Instr
    XADD Format
    format (Reg -> Operand
    OpReg Reg
    arg) (AddrMode -> Operand
    OpAddr AddrMode
    amode))
                                       , Format -> Operand -> Operand -> Instr
    MOV Format
    format (Reg -> Operand
    OpReg Reg
    arg) (Reg -> Operand
    OpReg Reg
    dst_r)
                                       ], Label
    bid)
            -- In these cases we need a new block id, and have to return it so
            -- that later instruction selection can reference it.
            AtomicMachOp
    AMO_And  -> (Operand -> Operand -> OrdList Instr)
    -> NatM (OrdList Instr, Label)
    cmpxchg_code (\ Operand
    src Operand
    dst -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Format -> Operand -> Operand -> Instr
    AND Format
    format Operand
    src Operand
    dst)
            AtomicMachOp
    AMO_Nand -> (Operand -> Operand -> OrdList Instr)
    -> NatM (OrdList Instr, Label)
    cmpxchg_code (\ Operand
    src Operand
    dst -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Format -> Operand -> Operand -> Instr
    AND Format
    format Operand
    src Operand
    dst
                                                        , Format -> Operand -> Instr
    NOT Format
    format Operand
    dst
                                                        ])
            AtomicMachOp
    AMO_Or   -> (Operand -> Operand -> OrdList Instr)
    -> NatM (OrdList Instr, Label)
    cmpxchg_code (\ Operand
    src Operand
    dst -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Format -> Operand -> Operand -> Instr
    OR Format
    format Operand
    src Operand
    dst)
            AtomicMachOp
    AMO_Xor  -> (Operand -> Operand -> OrdList Instr)
    -> NatM (OrdList Instr, Label)
    cmpxchg_code (\ Operand
    src Operand
    dst -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Format -> Operand -> Operand -> Instr
    XOR Format
    format Operand
    src Operand
    dst)
          where
            -- Simulate operation that lacks a dedicated instruction using
            -- cmpxchg.
            cmpxchg_code :: (Operand -> Operand -> OrdList Instr)
                         -> NatM (OrdList Instr, BlockId)
            cmpxchg_code :: (Operand -> Operand -> OrdList Instr)
    -> NatM (OrdList Instr, Label)
    cmpxchg_code Operand -> Operand -> OrdList Instr
    instrs = do
                Label
    lbl1 <- NatM Label
    getBlockIdNat
                Label
    lbl2 <- NatM Label
    getBlockIdNat
                Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    format

                --Record inserted blocks
                --  We turn A -> B into A -> A' -> A'' -> B
                --  with a self loop on A'.
                Label -> Label -> NatM ()
    addImmediateSuccessorNat Label
    bid Label
    lbl1
                Label -> Label -> NatM ()
    addImmediateSuccessorNat Label
    lbl1 Label
    lbl2
                (CFG -> CFG) -> NatM ()
    updateCfgNat (Label -> Label -> EdgeWeight -> CFG -> CFG
    addWeightEdge Label
    lbl1 Label
    lbl1 EdgeWeight
    0)

                (OrdList Instr, Label) -> NatM (OrdList Instr, Label)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((OrdList Instr, Label) -> NatM (OrdList Instr, Label))
    -> (OrdList Instr, Label) -> NatM (OrdList Instr, Label)
    forall a b. (a -> b) -> a -> b
    $ ([Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                    [ Format -> Operand -> Operand -> Instr
    MOV Format
    format (AddrMode -> Operand
    OpAddr AddrMode
    amode) (Reg -> Operand
    OpReg Reg
    eax)
                    , Cond -> Label -> Instr
    JXX Cond
    ALWAYS Label
    lbl1
                    , Label -> Instr
    NEWBLOCK Label
    lbl1
                      -- Keep old value so we can return it:
                    , Format -> Operand -> Operand -> Instr
    MOV Format
    format (Reg -> Operand
    OpReg Reg
    eax) (Reg -> Operand
    OpReg Reg
    dst_r)
                    , Format -> Operand -> Operand -> Instr
    MOV Format
    format (Reg -> Operand
    OpReg Reg
    eax) (Reg -> Operand
    OpReg Reg
    tmp)
                    ]
                    OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Operand -> Operand -> OrdList Instr
    instrs (Reg -> Operand
    OpReg Reg
    arg) (Reg -> Operand
    OpReg Reg
    tmp) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                    [ Instr -> Instr
    LOCK (Format -> Operand -> Operand -> Instr
    CMPXCHG Format
    format (Reg -> Operand
    OpReg Reg
    tmp) (AddrMode -> Operand
    OpAddr AddrMode
    amode))
                    , Cond -> Label -> Instr
    JXX Cond
    NE Label
    lbl1
                    -- See Note [Introducing cfg edges inside basic blocks]
                    -- why this basic block is required.
                    , Cond -> Label -> Instr
    JXX Cond
    ALWAYS Label
    lbl2
                    , Label -> Instr
    NEWBLOCK Label
    lbl2
                    ],
                    Label
    lbl2)
        format :: Format
    format = Width -> Format
    intFormat Width
    width

    -- | Count trailing zeroes
    genCtz :: BlockId -> Width -> LocalReg -> CmmExpr -> NatM (InstrBlock, Maybe BlockId)
    genCtz :: Label
    -> Width
    -> LocalReg
    -> CmmExpr
    -> NatM (OrdList Instr, Maybe Label)
    genCtz Label
    bid Width
    width LocalReg
    dst CmmExpr
    src = do
      Bool
    is32Bit <- NatM Bool
    is32BitPlatform
      if Bool
    is32Bit Bool -> Bool -> Bool
    && Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64
        then Label -> LocalReg -> CmmExpr -> NatM (OrdList Instr, Maybe Label)
    genCtz64_32 Label
    bid LocalReg
    dst CmmExpr
    src
        else (,Maybe Label
    forall a. Maybe a
    Nothing) (OrdList Instr -> (OrdList Instr, Maybe Label))
    -> NatM (OrdList Instr) -> NatM (OrdList Instr, Maybe Label)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genCtzGeneric Width
    width LocalReg
    dst CmmExpr
    src

    -- | Count trailing zeroes
    --
    -- 64-bit width on 32-bit architecture
    genCtz64_32
      :: BlockId
      -> LocalReg
      -> CmmExpr
      -> NatM (InstrBlock, Maybe BlockId)
    genCtz64_32 :: Label -> LocalReg -> CmmExpr -> NatM (OrdList Instr, Maybe Label)
    genCtz64_32 Label
    bid LocalReg
    dst CmmExpr
    src = do
      RegCode64 OrdList Instr
    vcode Reg
    rhi Reg
    rlo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    src
      let dst_r :: Reg
    dst_r = LocalReg -> Reg
    getLocalRegReg LocalReg
    dst
      Label
    lbl1 <- NatM Label
    getBlockIdNat
      Label
    lbl2 <- NatM Label
    getBlockIdNat
      Reg
    tmp_r <- Format -> NatM Reg
    getNewRegNat Format
    II64

      -- New CFG Edges:
      --  bid -> lbl2
      --  bid -> lbl1 -> lbl2
      --  We also changes edges originating at bid to start at lbl2 instead.
      Weights
    weights <- NatM Weights
    getCfgWeights
      (CFG -> CFG) -> NatM ()
    updateCfgNat (Label -> Label -> EdgeWeight -> CFG -> CFG
    addWeightEdge Label
    bid Label
    lbl1 EdgeWeight
    110 (CFG -> CFG) -> (CFG -> CFG) -> CFG -> CFG
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                    Label -> Label -> EdgeWeight -> CFG -> CFG
    addWeightEdge Label
    lbl1 Label
    lbl2 EdgeWeight
    110 (CFG -> CFG) -> (CFG -> CFG) -> CFG -> CFG
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                    Weights -> Label -> Label -> CFG -> CFG
    addImmediateSuccessor Weights
    weights Label
    bid Label
    lbl2)

      -- The following instruction sequence corresponds to the pseudo-code
      --
      --  if (src) {
      --    dst = src.lo32 ? BSF(src.lo32) : (BSF(src.hi32) + 32);
      --  } else {
      --    dst = 64;
      --  }
      let instrs :: OrdList Instr
    instrs = OrdList Instr
    vcode OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
               ([ Format -> Operand -> Operand -> Instr
    MOV      Format
    II32 (Reg -> Operand
    OpReg Reg
    rhi)         (Reg -> Operand
    OpReg Reg
    tmp_r)
                , Format -> Operand -> Operand -> Instr
    OR       Format
    II32 (Reg -> Operand
    OpReg Reg
    rlo)         (Reg -> Operand
    OpReg Reg
    tmp_r)
                , Format -> Operand -> Operand -> Instr
    MOV      Format
    II32 (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    64)) (Reg -> Operand
    OpReg Reg
    dst_r)
                , Cond -> Label -> Instr
    JXX Cond
    EQQ    Label
    lbl2
                , Cond -> Label -> Instr
    JXX Cond
    ALWAYS Label
    lbl1

                , Label -> Instr
    NEWBLOCK   Label
    lbl1
                , Format -> Operand -> Reg -> Instr
    BSF     Format
    II32 (Reg -> Operand
    OpReg Reg
    rhi)         Reg
    dst_r
                , Format -> Operand -> Operand -> Instr
    ADD     Format
    II32 (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    32)) (Reg -> Operand
    OpReg Reg
    dst_r)
                , Format -> Operand -> Reg -> Instr
    BSF     Format
    II32 (Reg -> Operand
    OpReg Reg
    rlo)         Reg
    tmp_r
                , Cond -> Format -> Operand -> Reg -> Instr
    CMOV Cond
    NE Format
    II32 (Reg -> Operand
    OpReg Reg
    tmp_r)       Reg
    dst_r
                , Cond -> Label -> Instr
    JXX Cond
    ALWAYS Label
    lbl2

                , Label -> Instr
    NEWBLOCK   Label
    lbl2
                ])
      (OrdList Instr, Maybe Label) -> NatM (OrdList Instr, Maybe Label)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    instrs, Label -> Maybe Label
    forall a. a -> Maybe a
    Just Label
    lbl2)

    -- | Count trailing zeroes
    --
    -- Generic case (width <= word size)
    genCtzGeneric :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
    genCtzGeneric :: Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genCtzGeneric Width
    width LocalReg
    dst CmmExpr
    src = do
      Reg -> OrdList Instr
    code_src <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    src
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      let bw :: Int
    bw = Width -> Int
    widthInBits Width
    width
      let dst_r :: Reg
    dst_r = LocalReg -> Reg
    getLocalRegReg LocalReg
    dst
      if NCGConfig -> Maybe BmiVersion
    ncgBmiVersion NCGConfig
    config Maybe BmiVersion -> Maybe BmiVersion -> Bool
    forall a. Ord a => a -> a -> Bool
    >= BmiVersion -> Maybe BmiVersion
    forall a. a -> Maybe a
    Just BmiVersion
    BMI2
      then do
          Reg
    src_r <- Format -> NatM Reg
    getNewRegNat (Width -> Format
    intFormat Width
    width)
          let instrs :: OrdList Instr
    instrs = OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    appOL (Reg -> OrdList Instr
    code_src Reg
    src_r) (OrdList Instr -> OrdList Instr) -> OrdList Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ case Width
    width of
                  Width
    W8 -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                      [ Format -> Operand -> Operand -> Instr
    OR    Format
    II32 (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    0xFFFFFF00)) (Reg -> Operand
    OpReg Reg
    src_r)
                      , Format -> Operand -> Reg -> Instr
    TZCNT Format
    II32 (Reg -> Operand
    OpReg Reg
    src_r) Reg
    dst_r
                      ]
                  Width
    W16 -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                      [ Format -> Operand -> Reg -> Instr
    TZCNT  Format
    II16 (Reg -> Operand
    OpReg Reg
    src_r) Reg
    dst_r
                      , Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II16 (Reg -> Operand
    OpReg Reg
    dst_r) (Reg -> Operand
    OpReg Reg
    dst_r)
                      ]
                  Width
    _ -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Format -> Operand -> Reg -> Instr
    TZCNT (Width -> Format
    intFormat Width
    width) (Reg -> Operand
    OpReg Reg
    src_r) Reg
    dst_r
          OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    instrs
      else do
          -- The following insn sequence makes sure 'ctz 0' has a defined value.
          -- starting with Haswell, one could use the TZCNT insn instead.
          let format :: Format
    format = if Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8 then Format
    II16 else Width -> Format
    intFormat Width
    width
          Reg
    src_r <- Format -> NatM Reg
    getNewRegNat Format
    format
          Reg
    tmp_r <- Format -> NatM Reg
    getNewRegNat Format
    format
          let instrs :: OrdList Instr
    instrs = Reg -> OrdList Instr
    code_src Reg
    src_r OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                   ([ Format -> Operand -> Operand -> Instr
    MOVZxL  Format
    II8    (Reg -> Operand
    OpReg Reg
    src_r) (Reg -> Operand
    OpReg Reg
    src_r) | Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8 ] [Instr] -> [Instr] -> [Instr]
    forall a. [a] -> [a] -> [a]
    ++
                    [ Format -> Operand -> Reg -> Instr
    BSF     Format
    format (Reg -> Operand
    OpReg Reg
    src_r) Reg
    tmp_r
                    , Format -> Operand -> Operand -> Instr
    MOV     Format
    II32   (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    bw)) (Reg -> Operand
    OpReg Reg
    dst_r)
                    , Cond -> Format -> Operand -> Reg -> Instr
    CMOV Cond
    NE Format
    format (Reg -> Operand
    OpReg Reg
    tmp_r) Reg
    dst_r
                    ]) -- NB: We don't need to zero-extend the result for the
                       -- W8/W16 cases because the 'MOV' insn already
                       -- took care of implicitly clearing the upper bits
          OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    instrs

    -- | Copy memory
    --
    -- Unroll memcpy calls if the number of bytes to copy isn't too large (cf
    -- ncgInlineThresholdMemcpy).  Otherwise, call C's memcpy.
    genMemCpy
      :: BlockId
      -> Int
      -> CmmExpr
      -> CmmExpr
      -> CmmExpr
      -> NatM InstrBlock
    genMemCpy :: Label
    -> Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genMemCpy Label
    bid Int
    align CmmExpr
    dst CmmExpr
    src CmmExpr
    arg_n = do

      let libc_memcpy :: NatM (OrdList Instr)
    libc_memcpy = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "memcpy") [] [CmmExpr
    dst,CmmExpr
    src,CmmExpr
    arg_n]

      case CmmExpr
    arg_n of
        CmmLit (CmmInt Integer
    n Width
    _) -> do
          -- try to inline it
          Maybe (OrdList Instr)
    mcode <- Int
    -> CmmExpr -> CmmExpr -> Integer -> NatM (Maybe (OrdList Instr))
    genMemCpyInlineMaybe Int
    align CmmExpr
    dst CmmExpr
    src Integer
    n
          -- if it didn't inline, call the C function
          case Maybe (OrdList Instr)
    mcode of
            Maybe (OrdList Instr)
    Nothing -> NatM (OrdList Instr)
    libc_memcpy
            Just OrdList Instr
    c  -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure OrdList Instr
    c

        -- not a literal size argument: call the C function
        CmmExpr
    _ -> NatM (OrdList Instr)
    libc_memcpy

    genMemCpyInlineMaybe
      :: Int
      -> CmmExpr
      -> CmmExpr
      -> Integer
      -> NatM (Maybe InstrBlock)
    genMemCpyInlineMaybe :: Int
    -> CmmExpr -> CmmExpr -> Integer -> NatM (Maybe (OrdList Instr))
    genMemCpyInlineMaybe Int
    align CmmExpr
    dst CmmExpr
    src Integer
    n = do
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      let
        platform :: Platform
    platform     = NCGConfig -> Platform
    ncgPlatform NCGConfig
    config
        maxAlignment :: Alignment
    maxAlignment = Platform -> Alignment
    wordAlignment Platform
    platform
                       -- only machine word wide MOVs are supported
        effectiveAlignment :: Alignment
    effectiveAlignment = Alignment -> Alignment -> Alignment
    forall a. Ord a => a -> a -> a
    min (Int -> Alignment
    alignmentOf Int
    align) Alignment
    maxAlignment
        format :: Format
    format = Width -> Format
    intFormat (Width -> Format) -> (Int -> Width) -> Int -> Format
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Width
    widthFromBytes (Int -> Format) -> Int -> Format
    forall a b. (a -> b) -> a -> b
    $ Alignment -> Int
    alignmentBytes Alignment
    effectiveAlignment

      -- The size of each move, in bytes.
      let sizeBytes :: Integer
          sizeBytes :: Integer
    sizeBytes = Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Format -> Int
    formatInBytes Format
    format)

      -- The number of instructions we will generate (approx). We need 2
      -- instructions per move.
      let insns :: Integer
    insns = Integer
    2 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * ((Integer
    n Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    sizeBytes Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    1) Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `div` Integer
    sizeBytes)

          go :: Reg -> Reg -> Reg -> Integer -> OrdList Instr
          go :: Reg -> Reg -> Reg -> Integer -> OrdList Instr
    go Reg
    dst Reg
    src Reg
    tmp Integer
    i
              | Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    sizeBytes =
                  Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV Format
    format (AddrMode -> Operand
    OpAddr AddrMode
    src_addr) (Reg -> Operand
    OpReg Reg
    tmp)) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                  Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV Format
    format (Reg -> Operand
    OpReg Reg
    tmp) (AddrMode -> Operand
    OpAddr AddrMode
    dst_addr)) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                  Reg -> Reg -> Reg -> Integer -> OrdList Instr
    go Reg
    dst Reg
    src Reg
    tmp (Integer
    i Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    sizeBytes)
              -- Deal with remaining bytes.
              | Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    4 =  -- Will never happen on 32-bit
                  Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (AddrMode -> Operand
    OpAddr AddrMode
    src_addr) (Reg -> Operand
    OpReg Reg
    tmp)) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                  Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    tmp) (AddrMode -> Operand
    OpAddr AddrMode
    dst_addr)) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                  Reg -> Reg -> Reg -> Integer -> OrdList Instr
    go Reg
    dst Reg
    src Reg
    tmp (Integer
    i Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    4)
              | Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    2 =
                  Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II16 (AddrMode -> Operand
    OpAddr AddrMode
    src_addr) (Reg -> Operand
    OpReg Reg
    tmp)) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                  Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV Format
    II16 (Reg -> Operand
    OpReg Reg
    tmp) (AddrMode -> Operand
    OpAddr AddrMode
    dst_addr)) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                  Reg -> Reg -> Reg -> Integer -> OrdList Instr
    go Reg
    dst Reg
    src Reg
    tmp (Integer
    i Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    2)
              | Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    1 =
                  Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II8 (AddrMode -> Operand
    OpAddr AddrMode
    src_addr) (Reg -> Operand
    OpReg Reg
    tmp)) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                  Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV Format
    II8 (Reg -> Operand
    OpReg Reg
    tmp) (AddrMode -> Operand
    OpAddr AddrMode
    dst_addr)) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                  Reg -> Reg -> Reg -> Integer -> OrdList Instr
    go Reg
    dst Reg
    src Reg
    tmp (Integer
    i Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    1)
              | Bool
    otherwise = OrdList Instr
    forall a. OrdList a
    nilOL
            where
              src_addr :: AddrMode
    src_addr = EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex (Reg -> EABase
    EABaseReg Reg
    src) EAIndex
    EAIndexNone
                           (Integer -> Imm
    ImmInteger (Integer
    n Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    i))

              dst_addr :: AddrMode
    dst_addr = EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex (Reg -> EABase
    EABaseReg Reg
    dst) EAIndex
    EAIndexNone
                           (Integer -> Imm
    ImmInteger (Integer
    n Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    i))

      if Integer
    insns Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (NCGConfig -> Word
    ncgInlineThresholdMemcpy NCGConfig
    config)
        then Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr))
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (OrdList Instr)
    forall a. Maybe a
    Nothing
        else do
          Reg -> OrdList Instr
    code_dst <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    dst
          Reg
    dst_r <- Format -> NatM Reg
    getNewRegNat Format
    format
          Reg -> OrdList Instr
    code_src <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    src
          Reg
    src_r <- Format -> NatM Reg
    getNewRegNat Format
    format
          Reg
    tmp_r <- Format -> NatM Reg
    getNewRegNat Format
    format
          Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr))
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr)))
    -> Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr))
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr -> Maybe (OrdList Instr)
    forall a. a -> Maybe a
    Just (OrdList Instr -> Maybe (OrdList Instr))
    -> OrdList Instr -> Maybe (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Reg -> OrdList Instr
    code_dst Reg
    dst_r OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> OrdList Instr
    code_src Reg
    src_r OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                          Reg -> Reg -> Reg -> Integer -> OrdList Instr
    go Reg
    dst_r Reg
    src_r Reg
    tmp_r (Integer -> Integer
    forall a. Num a => Integer -> a
    fromInteger Integer
    n)

    -- | Set memory to the given byte
    --
    -- Unroll memset calls if the number of bytes to copy isn't too large (cf
    -- ncgInlineThresholdMemset).  Otherwise, call C's memset.
    genMemSet
      :: BlockId
      -> Int
      -> CmmExpr
      -> CmmExpr
      -> CmmExpr
      -> NatM InstrBlock
    genMemSet :: Label
    -> Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genMemSet Label
    bid Int
    align CmmExpr
    dst CmmExpr
    arg_c CmmExpr
    arg_n = do

      let libc_memset :: NatM (OrdList Instr)
    libc_memset = Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "memset") [] [CmmExpr
    dst,CmmExpr
    arg_c,CmmExpr
    arg_n]

      case (CmmExpr
    arg_c,CmmExpr
    arg_n) of
        (CmmLit (CmmInt Integer
    c Width
    _), CmmLit (CmmInt Integer
    n Width
    _)) -> do
          -- try to inline it
          Maybe (OrdList Instr)
    mcode <- Int
    -> CmmExpr -> Integer -> Integer -> NatM (Maybe (OrdList Instr))
    genMemSetInlineMaybe Int
    align CmmExpr
    dst Integer
    c Integer
    n
          -- if it didn't inline, call the C function
          case Maybe (OrdList Instr)
    mcode of
            Maybe (OrdList Instr)
    Nothing -> NatM (OrdList Instr)
    libc_memset
            Just OrdList Instr
    c  -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure OrdList Instr
    c

        -- not literal size arguments: call the C function
        (CmmExpr, CmmExpr)
    _ -> NatM (OrdList Instr)
    libc_memset

    genMemSetInlineMaybe
      :: Int
      -> CmmExpr
      -> Integer
      -> Integer
      -> NatM (Maybe InstrBlock)
    genMemSetInlineMaybe :: Int
    -> CmmExpr -> Integer -> Integer -> NatM (Maybe (OrdList Instr))
    genMemSetInlineMaybe Int
    align CmmExpr
    dst Integer
    c Integer
    n = do
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      let
        platform :: Platform
    platform = NCGConfig -> Platform
    ncgPlatform NCGConfig
    config
        maxAlignment :: Alignment
    maxAlignment = Platform -> Alignment
    wordAlignment Platform
    platform -- only machine word wide MOVs are supported
        effectiveAlignment :: Alignment
    effectiveAlignment = Alignment -> Alignment -> Alignment
    forall a. Ord a => a -> a -> a
    min (Int -> Alignment
    alignmentOf Int
    align) Alignment
    maxAlignment
        format :: Format
    format = Width -> Format
    intFormat (Width -> Format) -> (Int -> Width) -> Int -> Format
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Width
    widthFromBytes (Int -> Format) -> Int -> Format
    forall a b. (a -> b) -> a -> b
    $ Alignment -> Int
    alignmentBytes Alignment
    effectiveAlignment
        c2 :: Integer
    c2 = Integer
    c Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    8 Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    .|. Integer
    c
        c4 :: Integer
    c4 = Integer
    c2 Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    16 Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    .|. Integer
    c2
        c8 :: Integer
    c8 = Integer
    c4 Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    32 Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    .|. Integer
    c4

        -- The number of instructions we will generate (approx). We need 1
        -- instructions per move.
        insns :: Integer
    insns = (Integer
    n Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    sizeBytes Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    1) Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `div` Integer
    sizeBytes

        -- The size of each move, in bytes.
        sizeBytes :: Integer
        sizeBytes :: Integer
    sizeBytes = Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Format -> Int
    formatInBytes Format
    format)

        -- Depending on size returns the widest MOV instruction and its
        -- width.
        gen4 :: AddrMode -> Integer -> (InstrBlock, Integer)
        gen4 :: AddrMode -> Integer -> (OrdList Instr, Integer)
    gen4 AddrMode
    addr Integer
    size
            | Integer
    size Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    4 =
                (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    c4)) (AddrMode -> Operand
    OpAddr AddrMode
    addr)), Integer
    4)
            | Integer
    size Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    2 =
                (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV Format
    II16 (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    c2)) (AddrMode -> Operand
    OpAddr AddrMode
    addr)), Integer
    2)
            | Integer
    size Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    1 =
                (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV Format
    II8 (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    c)) (AddrMode -> Operand
    OpAddr AddrMode
    addr)), Integer
    1)
            | Bool
    otherwise = (OrdList Instr
    forall a. OrdList a
    nilOL, Integer
    0)

        -- Generates a 64-bit wide MOV instruction from REG to MEM.
        gen8 :: AddrMode -> Reg -> InstrBlock
        gen8 :: AddrMode -> Reg -> OrdList Instr
    gen8 AddrMode
    addr Reg
    reg8byte =
          Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOV Format
    format (Reg -> Operand
    OpReg Reg
    reg8byte) (AddrMode -> Operand
    OpAddr AddrMode
    addr))

        -- Unrolls memset when the widest MOV is <= 4 bytes.
        go4 :: Reg -> Integer -> InstrBlock
        go4 :: Reg -> Integer -> OrdList Instr
    go4 Reg
    dst Integer
    left =
          if Integer
    left Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    0 then OrdList Instr
    forall a. OrdList a
    nilOL
          else OrdList Instr
    curMov OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> Integer -> OrdList Instr
    go4 Reg
    dst (Integer
    left Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    curWidth)
          where
            possibleWidth :: Integer
    possibleWidth = [Integer] -> Integer
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum [Integer
    left, Integer
    sizeBytes]
            dst_addr :: AddrMode
    dst_addr = EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex (Reg -> EABase
    EABaseReg Reg
    dst) EAIndex
    EAIndexNone (Integer -> Imm
    ImmInteger (Integer
    n Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    left))
            (OrdList Instr
    curMov, Integer
    curWidth) = AddrMode -> Integer -> (OrdList Instr, Integer)
    gen4 AddrMode
    dst_addr Integer
    possibleWidth

        -- Unrolls memset when the widest MOV is 8 bytes (thus another Reg
        -- argument). Falls back to go4 when all 8 byte moves are
        -- exhausted.
        go8 :: Reg -> Reg -> Integer -> InstrBlock
        go8 :: Reg -> Reg -> Integer -> OrdList Instr
    go8 Reg
    dst Reg
    reg8byte Integer
    left =
          if Integer
    possibleWidth Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    8 then
            let curMov :: OrdList Instr
    curMov = AddrMode -> Reg -> OrdList Instr
    gen8 AddrMode
    dst_addr Reg
    reg8byte
            in  OrdList Instr
    curMov OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> Reg -> Integer -> OrdList Instr
    go8 Reg
    dst Reg
    reg8byte (Integer
    left Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    8)
          else Reg -> Integer -> OrdList Instr
    go4 Reg
    dst Integer
    left
          where
            possibleWidth :: Integer
    possibleWidth = [Integer] -> Integer
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum [Integer
    left, Integer
    sizeBytes]
            dst_addr :: AddrMode
    dst_addr = EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex (Reg -> EABase
    EABaseReg Reg
    dst) EAIndex
    EAIndexNone (Integer -> Imm
    ImmInteger (Integer
    n Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    left))

      if Integer -> Word
    forall a. Num a => Integer -> a
    fromInteger Integer
    insns Word -> Word -> Bool
    forall a. Ord a => a -> a -> Bool
    > NCGConfig -> Word
    ncgInlineThresholdMemset NCGConfig
    config
        then Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr))
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (OrdList Instr)
    forall a. Maybe a
    Nothing
        else do
            Reg -> OrdList Instr
    code_dst <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    dst
            Reg
    dst_r <- Format -> NatM Reg
    getNewRegNat Format
    format
            if Format
    format Format -> Format -> Bool
    forall a. Eq a => a -> a -> Bool
    == Format
    II64 Bool -> Bool -> Bool
    && Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    8
              then do
                Reg -> OrdList Instr
    code_imm8byte <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg (CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt Integer
    c8 Width
    W64))
                Reg
    imm8byte_r <- Format -> NatM Reg
    getNewRegNat Format
    II64
                Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr))
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr)))
    -> Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr))
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr -> Maybe (OrdList Instr)
    forall a. a -> Maybe a
    Just (OrdList Instr -> Maybe (OrdList Instr))
    -> OrdList Instr -> Maybe (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Reg -> OrdList Instr
    code_dst Reg
    dst_r OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                                  Reg -> OrdList Instr
    code_imm8byte Reg
    imm8byte_r OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                                  Reg -> Reg -> Integer -> OrdList Instr
    go8 Reg
    dst_r Reg
    imm8byte_r (Integer -> Integer
    forall a. Num a => Integer -> a
    fromInteger Integer
    n)
              else
                Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr))
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr)))
    -> Maybe (OrdList Instr) -> NatM (Maybe (OrdList Instr))
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr -> Maybe (OrdList Instr)
    forall a. a -> Maybe a
    Just (OrdList Instr -> Maybe (OrdList Instr))
    -> OrdList Instr -> Maybe (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Reg -> OrdList Instr
    code_dst Reg
    dst_r OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                                  Reg -> Integer -> OrdList Instr
    go4 Reg
    dst_r (Integer -> Integer
    forall a. Num a => Integer -> a
    fromInteger Integer
    n)

    genMemMove :: BlockId -> p -> CmmActual -> CmmActual -> CmmActual -> NatM InstrBlock
    genMemMove :: forall p.
    Label -> p -> CmmExpr -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genMemMove Label
    bid p
    _align CmmExpr
    dst CmmExpr
    src CmmExpr
    n = do
      -- TODO: generate inline assembly when under a given treshold (similarly to
      -- memcpy and memset)
      Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "memmove") [] [CmmExpr
    dst,CmmExpr
    src,CmmExpr
    n]

    genMemCmp :: BlockId -> p -> CmmFormal -> CmmActual -> CmmActual -> CmmActual -> NatM InstrBlock
    genMemCmp :: forall p.
    Label
    -> p
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genMemCmp Label
    bid p
    _align LocalReg
    res CmmExpr
    dst CmmExpr
    src CmmExpr
    n = do
      -- TODO: generate inline assembly when under a given treshold (similarly to
      -- memcpy and memset)
      Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genLibCCall Label
    bid (String -> FastString
    fsLit String
    "memcmp") [LocalReg
    res] [CmmExpr
    dst,CmmExpr
    src,CmmExpr
    n]

    genPrefetchData :: Int -> CmmExpr -> NatM (OrdList Instr)
    genPrefetchData :: Int -> CmmExpr -> NatM (OrdList Instr)
    genPrefetchData Int
    n CmmExpr
    src = do
      Bool
    is32Bit <- NatM Bool
    is32BitPlatform
      let
        format :: Format
    format = Bool -> Format
    archWordFormat Bool
    is32Bit
        -- need to know what register width for pointers!
        genPrefetch :: CmmExpr -> (Operand -> Instr) -> NatM (OrdList Instr)
    genPrefetch CmmExpr
    inRegSrc Operand -> Instr
    prefetchCTor = do
          Reg -> OrdList Instr
    code_src <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    inRegSrc
          Reg
    src_r <- Format -> NatM Reg
    getNewRegNat Format
    format
          OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Reg -> OrdList Instr
    code_src Reg
    src_r OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
            (Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Operand -> Instr
    prefetchCTor  (AddrMode -> Operand
    OpAddr
                        ((EABase -> EAIndex -> Imm -> AddrMode
    AddrBaseIndex (Reg -> EABase
    EABaseReg Reg
    src_r )   EAIndex
    EAIndexNone (Int -> Imm
    ImmInt Int
    0))))  ))
            -- prefetch always takes an address

      -- the c / llvm prefetch convention is 0, 1, 2, and 3
      -- the x86 corresponding names are : NTA, 2 , 1, and 0
      case Int
    n of
          Int
    0 -> CmmExpr -> (Operand -> Instr) -> NatM (OrdList Instr)
    genPrefetch CmmExpr
    src ((Operand -> Instr) -> NatM (OrdList Instr))
    -> (Operand -> Instr) -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ PrefetchVariant -> Format -> Operand -> Instr
    PREFETCH PrefetchVariant
    NTA  Format
    format
          Int
    1 -> CmmExpr -> (Operand -> Instr) -> NatM (OrdList Instr)
    genPrefetch CmmExpr
    src ((Operand -> Instr) -> NatM (OrdList Instr))
    -> (Operand -> Instr) -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ PrefetchVariant -> Format -> Operand -> Instr
    PREFETCH PrefetchVariant
    Lvl2 Format
    format
          Int
    2 -> CmmExpr -> (Operand -> Instr) -> NatM (OrdList Instr)
    genPrefetch CmmExpr
    src ((Operand -> Instr) -> NatM (OrdList Instr))
    -> (Operand -> Instr) -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ PrefetchVariant -> Format -> Operand -> Instr
    PREFETCH PrefetchVariant
    Lvl1 Format
    format
          Int
    3 -> CmmExpr -> (Operand -> Instr) -> NatM (OrdList Instr)
    genPrefetch CmmExpr
    src ((Operand -> Instr) -> NatM (OrdList Instr))
    -> (Operand -> Instr) -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ PrefetchVariant -> Format -> Operand -> Instr
    PREFETCH PrefetchVariant
    Lvl0 Format
    format
          Int
    l -> String -> SDoc -> NatM (OrdList Instr)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "genPrefetchData: unexpected prefetch level" (Int -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Int
    l)

    genByteSwap :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
    genByteSwap :: Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genByteSwap Width
    width LocalReg
    dst CmmExpr
    src = do
      Bool
    is32Bit <- NatM Bool
    is32BitPlatform
      let format :: Format
    format = Width -> Format
    intFormat Width
    width
      case Width
    width of
          Width
    W64 | Bool
    is32Bit -> do
            let Reg64 Reg
    dst_hi Reg
    dst_lo = (() :: Constraint) => LocalReg -> Reg64
    LocalReg -> Reg64
    localReg64 LocalReg
    dst
            RegCode64 OrdList Instr
    vcode Reg
    rhi Reg
    rlo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    src
            OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    vcode OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                     [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    rlo) (Reg -> Operand
    OpReg Reg
    dst_hi),
                            Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    rhi) (Reg -> Operand
    OpReg Reg
    dst_lo),
                            Format -> Reg -> Instr
    BSWAP Format
    II32 Reg
    dst_hi,
                            Format -> Reg -> Instr
    BSWAP Format
    II32 Reg
    dst_lo ]
          Width
    W16 -> do
            let dst_r :: Reg
    dst_r = LocalReg -> Reg
    getLocalRegReg LocalReg
    dst
            Reg -> OrdList Instr
    code_src <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    src
            OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Reg -> OrdList Instr
    code_src Reg
    dst_r OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                     Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Reg -> Instr
    BSWAP Format
    II32 Reg
    dst_r) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                     Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    SHR Format
    II32 (Imm -> Operand
    OpImm (Imm -> Operand) -> Imm -> Operand
    forall a b. (a -> b) -> a -> b
    $ Int -> Imm
    ImmInt Int
    16) (Reg -> Operand
    OpReg Reg
    dst_r))
          Width
    _   -> do
            let dst_r :: Reg
    dst_r = LocalReg -> Reg
    getLocalRegReg LocalReg
    dst
            Reg -> OrdList Instr
    code_src <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    src
            OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Reg -> OrdList Instr
    code_src Reg
    dst_r OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Reg -> Instr
    BSWAP Format
    format Reg
    dst_r)

    genBitRev :: BlockId -> Width -> CmmFormal -> CmmActual -> NatM InstrBlock
    genBitRev :: Label -> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genBitRev Label
    bid Width
    width LocalReg
    dst CmmExpr
    src = do
      -- Here the C implementation (hs_bitrevN) is used as there is no x86
      -- instruction to reverse a word's bit order.
      Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genPrimCCall Label
    bid (Width -> FastString
    bRevLabel Width
    width) [LocalReg
    dst] [CmmExpr
    src]

    genPopCnt :: BlockId -> Width -> LocalReg -> CmmExpr -> NatM InstrBlock
    genPopCnt :: Label -> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genPopCnt Label
    bid Width
    width LocalReg
    dst CmmExpr
    src = do
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      let
        platform :: Platform
    platform = NCGConfig -> Platform
    ncgPlatform NCGConfig
    config
        format :: Format
    format = Width -> Format
    intFormat Width
    width

      NatM Bool
    sse4_2Enabled NatM Bool -> (Bool -> NatM (OrdList Instr)) -> NatM (OrdList Instr)
    forall a b. NatM a -> (a -> NatM b) -> NatM b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case

        Bool
    True -> do
          Reg -> OrdList Instr
    code_src <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    src
          Reg
    src_r <- Format -> NatM Reg
    getNewRegNat Format
    format
          let dst_r :: Reg
    dst_r = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform  (LocalReg -> CmmReg
    CmmLocal LocalReg
    dst)
          OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Reg -> OrdList Instr
    code_src Reg
    src_r OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
              (if Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8 then
                   -- The POPCNT instruction doesn't take a r/m8
                   Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II8 (Reg -> Operand
    OpReg Reg
    src_r) (Reg -> Operand
    OpReg Reg
    src_r)) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                   Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Reg -> Instr
    POPCNT Format
    II16 (Reg -> Operand
    OpReg Reg
    src_r) Reg
    dst_r)
               else
                   Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Reg -> Instr
    POPCNT Format
    format (Reg -> Operand
    OpReg Reg
    src_r) Reg
    dst_r)) OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
              (if Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8 Bool -> Bool -> Bool
    || Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W16 then
                   -- We used a 16-bit destination register above,
                   -- so zero-extend
                   Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II16 (Reg -> Operand
    OpReg Reg
    dst_r) (Reg -> Operand
    OpReg Reg
    dst_r))
               else OrdList Instr
    forall a. OrdList a
    nilOL)

        Bool
    False ->
          -- generate C call to hs_popcntN in ghc-prim
          -- TODO: we could directly generate the assembly to index popcount_tab
          -- here instead of doing it by calling a C function
          Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genPrimCCall Label
    bid (Width -> FastString
    popCntLabel Width
    width) [LocalReg
    dst] [CmmExpr
    src]

    genPdep :: BlockId -> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genPdep :: Label
    -> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genPdep Label
    bid Width
    width LocalReg
    dst CmmExpr
    src CmmExpr
    mask = do
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      let
        platform :: Platform
    platform = NCGConfig -> Platform
    ncgPlatform NCGConfig
    config
        format :: Format
    format = Width -> Format
    intFormat Width
    width

      if NCGConfig -> Maybe BmiVersion
    ncgBmiVersion NCGConfig
    config Maybe BmiVersion -> Maybe BmiVersion -> Bool
    forall a. Ord a => a -> a -> Bool
    >= BmiVersion -> Maybe BmiVersion
    forall a. a -> Maybe a
    Just BmiVersion
    BMI2
        then do
          Reg -> OrdList Instr
    code_src  <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    src
          Reg -> OrdList Instr
    code_mask <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    mask
          Reg
    src_r     <- Format -> NatM Reg
    getNewRegNat Format
    format
          Reg
    mask_r    <- Format -> NatM Reg
    getNewRegNat Format
    format
          let dst_r :: Reg
    dst_r = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform  (LocalReg -> CmmReg
    CmmLocal LocalReg
    dst)
          OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Reg -> OrdList Instr
    code_src Reg
    src_r OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> OrdList Instr
    code_mask Reg
    mask_r OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
              -- PDEP only supports > 32 bit args
              ( if Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8 Bool -> Bool -> Bool
    || Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W16 then
                  [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                    [ Format -> Operand -> Operand -> Instr
    MOVZxL Format
    format (Reg -> Operand
    OpReg Reg
    src_r ) (Reg -> Operand
    OpReg Reg
    src_r )
                    , Format -> Operand -> Operand -> Instr
    MOVZxL Format
    format (Reg -> Operand
    OpReg Reg
    mask_r) (Reg -> Operand
    OpReg Reg
    mask_r)
                    , Format -> Operand -> Operand -> Reg -> Instr
    PDEP   Format
    II32 (Reg -> Operand
    OpReg Reg
    mask_r) (Reg -> Operand
    OpReg Reg
    src_r ) Reg
    dst_r
                    , Format -> Operand -> Operand -> Instr
    MOVZxL Format
    format (Reg -> Operand
    OpReg Reg
    dst_r) (Reg -> Operand
    OpReg Reg
    dst_r) -- Truncate to op width
                    ]
                else
                  Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Reg -> Instr
    PDEP Format
    format (Reg -> Operand
    OpReg Reg
    mask_r) (Reg -> Operand
    OpReg Reg
    src_r) Reg
    dst_r)
              )
        else
          -- generate C call to hs_pdepN in ghc-prim
          Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genPrimCCall Label
    bid (Width -> FastString
    pdepLabel Width
    width) [LocalReg
    dst] [CmmExpr
    src,CmmExpr
    mask]

    genPext :: BlockId -> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genPext :: Label
    -> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genPext Label
    bid Width
    width LocalReg
    dst CmmExpr
    src CmmExpr
    mask = do
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      if NCGConfig -> Maybe BmiVersion
    ncgBmiVersion NCGConfig
    config Maybe BmiVersion -> Maybe BmiVersion -> Bool
    forall a. Ord a => a -> a -> Bool
    >= BmiVersion -> Maybe BmiVersion
    forall a. a -> Maybe a
    Just BmiVersion
    BMI2
        then do
          let format :: Format
    format   = Width -> Format
    intFormat Width
    width
          let dst_r :: Reg
    dst_r    = LocalReg -> Reg
    getLocalRegReg LocalReg
    dst
          Reg -> OrdList Instr
    code_src  <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    src
          Reg -> OrdList Instr
    code_mask <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    mask
          Reg
    src_r     <- Format -> NatM Reg
    getNewRegNat Format
    format
          Reg
    mask_r    <- Format -> NatM Reg
    getNewRegNat Format
    format
          OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Reg -> OrdList Instr
    code_src Reg
    src_r OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> OrdList Instr
    code_mask Reg
    mask_r OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
              (if Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8 Bool -> Bool -> Bool
    || Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W16 then
                   -- The PEXT instruction doesn't take a r/m8 or 16
                  [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                    [ Format -> Operand -> Operand -> Instr
    MOVZxL Format
    format (Reg -> Operand
    OpReg Reg
    src_r ) (Reg -> Operand
    OpReg Reg
    src_r )
                    , Format -> Operand -> Operand -> Instr
    MOVZxL Format
    format (Reg -> Operand
    OpReg Reg
    mask_r) (Reg -> Operand
    OpReg Reg
    mask_r)
                    , Format -> Operand -> Operand -> Reg -> Instr
    PEXT   Format
    II32 (Reg -> Operand
    OpReg Reg
    mask_r) (Reg -> Operand
    OpReg Reg
    src_r ) Reg
    dst_r
                    , Format -> Operand -> Operand -> Instr
    MOVZxL Format
    format (Reg -> Operand
    OpReg Reg
    dst_r) (Reg -> Operand
    OpReg Reg
    dst_r) -- Truncate to op width
                    ]
                else
                  Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Operand -> Reg -> Instr
    PEXT Format
    format (Reg -> Operand
    OpReg Reg
    mask_r) (Reg -> Operand
    OpReg Reg
    src_r) Reg
    dst_r)
              )
        else
          -- generate C call to hs_pextN in ghc-prim
          Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genPrimCCall Label
    bid (Width -> FastString
    pextLabel Width
    width) [LocalReg
    dst] [CmmExpr
    src,CmmExpr
    mask]

    genClz :: BlockId -> Width -> CmmFormal -> CmmActual -> NatM InstrBlock
    genClz :: Label -> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genClz Label
    bid Width
    width LocalReg
    dst CmmExpr
    src = do
      Bool
    is32Bit <- NatM Bool
    is32BitPlatform
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      if Bool
    is32Bit Bool -> Bool -> Bool
    && Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64

        then
          -- Fallback to `hs_clz64` on i386
          Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genPrimCCall Label
    bid (Width -> FastString
    clzLabel Width
    width) [LocalReg
    dst] [CmmExpr
    src]

        else do
          Reg -> OrdList Instr
    code_src <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    src
          let dst_r :: Reg
    dst_r = LocalReg -> Reg
    getLocalRegReg LocalReg
    dst
          if NCGConfig -> Maybe BmiVersion
    ncgBmiVersion NCGConfig
    config Maybe BmiVersion -> Maybe BmiVersion -> Bool
    forall a. Ord a => a -> a -> Bool
    >= BmiVersion -> Maybe BmiVersion
    forall a. a -> Maybe a
    Just BmiVersion
    BMI2
            then do
              Reg
    src_r <- Format -> NatM Reg
    getNewRegNat (Width -> Format
    intFormat Width
    width)
              OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    appOL (Reg -> OrdList Instr
    code_src Reg
    src_r) (OrdList Instr -> OrdList Instr) -> OrdList Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ case Width
    width of
                Width
    W8 -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                    [ Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II8  (Reg -> Operand
    OpReg Reg
    src_r)       (Reg -> Operand
    OpReg Reg
    src_r) -- zero-extend to 32 bit
                    , Format -> Operand -> Reg -> Instr
    LZCNT  Format
    II32 (Reg -> Operand
    OpReg Reg
    src_r)       Reg
    dst_r         -- lzcnt with extra 24 zeros
                    , Format -> Operand -> Operand -> Instr
    SUB    Format
    II32 (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    24)) (Reg -> Operand
    OpReg Reg
    dst_r) -- compensate for extra zeros
                    ]
                Width
    W16 -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                    [ Format -> Operand -> Reg -> Instr
    LZCNT  Format
    II16 (Reg -> Operand
    OpReg Reg
    src_r) Reg
    dst_r
                    , Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II16 (Reg -> Operand
    OpReg Reg
    dst_r) (Reg -> Operand
    OpReg Reg
    dst_r) -- zero-extend from 16 bit
                    ]
                Width
    _ -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Operand -> Reg -> Instr
    LZCNT (Width -> Format
    intFormat Width
    width) (Reg -> Operand
    OpReg Reg
    src_r) Reg
    dst_r)
            else do
              let format :: Format
    format = if Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8 then Format
    II16 else Width -> Format
    intFormat Width
    width
              let bw :: Int
    bw = Width -> Int
    widthInBits Width
    width
              Reg
    src_r <- Format -> NatM Reg
    getNewRegNat Format
    format
              Reg
    tmp_r <- Format -> NatM Reg
    getNewRegNat Format
    format
              OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Reg -> OrdList Instr
    code_src Reg
    src_r OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                       ([ Format -> Operand -> Operand -> Instr
    MOVZxL  Format
    II8    (Reg -> Operand
    OpReg Reg
    src_r) (Reg -> Operand
    OpReg Reg
    src_r) | Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W8 ] [Instr] -> [Instr] -> [Instr]
    forall a. [a] -> [a] -> [a]
    ++
                        [ Format -> Operand -> Reg -> Instr
    BSR     Format
    format (Reg -> Operand
    OpReg Reg
    src_r) Reg
    tmp_r
                        , Format -> Operand -> Operand -> Instr
    MOV     Format
    II32   (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt (Int
    2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    bwInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1))) (Reg -> Operand
    OpReg Reg
    dst_r)
                        , Cond -> Format -> Operand -> Reg -> Instr
    CMOV Cond
    NE Format
    format (Reg -> Operand
    OpReg Reg
    tmp_r) Reg
    dst_r
                        , Format -> Operand -> Operand -> Instr
    XOR     Format
    format (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt (Int
    bwInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1))) (Reg -> Operand
    OpReg Reg
    dst_r)
                        ]) -- NB: We don't need to zero-extend the result for the
                           -- W8/W16 cases because the 'MOV' insn already
                           -- took care of implicitly clearing the upper bits

    genWordToFloat :: BlockId -> Width -> CmmFormal -> CmmActual -> NatM InstrBlock
    genWordToFloat :: Label -> Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genWordToFloat Label
    bid Width
    width LocalReg
    dst CmmExpr
    src =
      -- TODO: generate assembly instead
      Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genPrimCCall Label
    bid (Width -> FastString
    word2FloatLabel Width
    width) [LocalReg
    dst] [CmmExpr
    src]

    genAtomicRead :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
    genAtomicRead :: Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genAtomicRead Width
    width LocalReg
    dst CmmExpr
    addr = do
      Reg -> OrdList Instr
    load_code <- (Operand -> Operand -> Instr)
    -> CmmExpr -> NatM (Reg -> OrdList Instr)
    intLoadCode (Format -> Operand -> Operand -> Instr
    MOV (Width -> Format
    intFormat Width
    width)) CmmExpr
    addr
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg -> OrdList Instr
    load_code (LocalReg -> Reg
    getLocalRegReg LocalReg
    dst))

    genAtomicWrite :: Width -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genAtomicWrite :: Width -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genAtomicWrite Width
    width CmmExpr
    addr CmmExpr
    val = do
      OrdList Instr
    code <- Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_IntCode (Width -> Format
    intFormat Width
    width) CmmExpr
    addr CmmExpr
    val
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    MFENCE

    genCmpXchg
      :: BlockId
      -> Width
      -> LocalReg
      -> CmmExpr
      -> CmmExpr
      -> CmmExpr
      -> NatM InstrBlock
    genCmpXchg :: Label
    -> Width
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genCmpXchg Label
    bid Width
    width LocalReg
    dst CmmExpr
    addr CmmExpr
    old CmmExpr
    new = do
      Bool
    is32Bit <- NatM Bool
    is32BitPlatform
      -- On x86 we don't have enough registers to use cmpxchg with a
      -- complicated addressing mode, so on that architecture we
      -- pre-compute the address first.
      if Bool -> Bool
    not (Bool
    is32Bit Bool -> Bool -> Bool
    && Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64)
        then do
          let format :: Format
    format = Width -> Format
    intFormat Width
    width
          Amode AddrMode
    amode OrdList Instr
    addr_code <- CmmExpr -> NatM Amode
    getSimpleAmode CmmExpr
    addr
          Reg
    newval <- Format -> NatM Reg
    getNewRegNat Format
    format
          Reg -> OrdList Instr
    newval_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    new
          Reg
    oldval <- Format -> NatM Reg
    getNewRegNat Format
    format
          Reg -> OrdList Instr
    oldval_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    old
          Platform
    platform <- NatM Platform
    getPlatform
          let dst_r :: Reg
    dst_r    = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform  (LocalReg -> CmmReg
    CmmLocal LocalReg
    dst)
              code :: OrdList Instr
    code     = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                         [ Format -> Operand -> Operand -> Instr
    MOV Format
    format (Reg -> Operand
    OpReg Reg
    oldval) (Reg -> Operand
    OpReg Reg
    eax)
                         , Instr -> Instr
    LOCK (Format -> Operand -> Operand -> Instr
    CMPXCHG Format
    format (Reg -> Operand
    OpReg Reg
    newval) (AddrMode -> Operand
    OpAddr AddrMode
    amode))
                         , Format -> Operand -> Operand -> Instr
    MOV Format
    format (Reg -> Operand
    OpReg Reg
    eax) (Reg -> Operand
    OpReg Reg
    dst_r)
                         ]
          OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    addr_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> OrdList Instr
    newval_code Reg
    newval OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> OrdList Instr
    oldval_code Reg
    oldval
              OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code
        else
          -- generate C call to hs_cmpxchgN in ghc-prim
          Label
    -> FastString -> [LocalReg] -> [CmmExpr] -> NatM (OrdList Instr)
    genPrimCCall Label
    bid (Width -> FastString
    cmpxchgLabel Width
    width) [LocalReg
    dst] [CmmExpr
    addr,CmmExpr
    old,CmmExpr
    new]
          -- TODO: implement cmpxchg8b instruction

    genXchg :: Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genXchg :: Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genXchg Width
    width LocalReg
    dst CmmExpr
    addr CmmExpr
    value = do
      Bool
    is32Bit <- NatM Bool
    is32BitPlatform

      Bool -> NatM () -> NatM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool
    is32Bit Bool -> Bool -> Bool
    && Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64) (NatM () -> NatM ()) -> NatM () -> NatM ()
    forall a b. (a -> b) -> a -> b
    $
        String -> NatM ()
    forall a. String -> a
    panic String
    "genXchg: 64bit atomic exchange not supported on 32bit platforms"

      Amode AddrMode
    amode OrdList Instr
    addr_code <- CmmExpr -> NatM Amode
    getSimpleAmode CmmExpr
    addr
      (Reg
    newval, OrdList Instr
    newval_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    value
      let format :: Format
    format   = Width -> Format
    intFormat Width
    width
      let dst_r :: Reg
    dst_r    = LocalReg -> Reg
    getLocalRegReg LocalReg
    dst
      -- Copy the value into the target register, perform the exchange.
      let code :: OrdList Instr
    code     = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                     [ Format -> Operand -> Operand -> Instr
    MOV Format
    format (Reg -> Operand
    OpReg Reg
    newval) (Reg -> Operand
    OpReg Reg
    dst_r)
                      -- On X86 xchg implies a lock prefix if we use a memory argument.
                      -- so this is atomic.
                     , Format -> Operand -> Reg -> Instr
    XCHG Format
    format (AddrMode -> Operand
    OpAddr AddrMode
    amode) Reg
    dst_r
                     ]
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    addr_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    newval_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code

    genFloatAbs :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
    genFloatAbs :: Width -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genFloatAbs Width
    width LocalReg
    dst CmmExpr
    src = do
      let
        format :: Format
    format = Width -> Format
    floatFormat Width
    width
        const :: CmmLit
    const = case Width
    width of
          Width
    W32 -> Integer -> Width -> CmmLit
    CmmInt Integer
    0x7fffffff Width
    W32
          Width
    W64 -> Integer -> Width -> CmmLit
    CmmInt Integer
    0x7fffffffffffffff Width
    W64
          Width
    _   -> String -> SDoc -> CmmLit
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "genFloatAbs: invalid width" (Width -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Width
    width)
      Reg -> OrdList Instr
    src_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    src
      Amode AddrMode
    amode OrdList Instr
    amode_code <- Alignment -> CmmLit -> NatM Amode
    memConstant (Int -> Alignment
    mkAlignment (Int -> Alignment) -> Int -> Alignment
    forall a b. (a -> b) -> a -> b
    $ Width -> Int
    widthInBytes Width
    width) CmmLit
    const
      Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    format
      let dst_r :: Reg
    dst_r = LocalReg -> Reg
    getLocalRegReg LocalReg
    dst
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Reg -> OrdList Instr
    src_code Reg
    dst_r OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    amode_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
               [ Format -> Operand -> Operand -> Instr
    MOV Format
    format (AddrMode -> Operand
    OpAddr AddrMode
    amode) (Reg -> Operand
    OpReg Reg
    tmp)
               , Format -> Operand -> Operand -> Instr
    AND Format
    format (Reg -> Operand
    OpReg Reg
    tmp) (Reg -> Operand
    OpReg Reg
    dst_r)
               ]

    genFloatSqrt :: Format -> LocalReg -> CmmExpr -> NatM InstrBlock
    genFloatSqrt :: Format -> LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genFloatSqrt Format
    format LocalReg
    dst CmmExpr
    src = do
      let dst_r :: Reg
    dst_r = LocalReg -> Reg
    getLocalRegReg LocalReg
    dst
      Reg -> OrdList Instr
    src_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    src
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Reg -> OrdList Instr
    src_code Reg
    dst_r OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Operand -> Reg -> Instr
    SQRT Format
    format (Reg -> Operand
    OpReg Reg
    dst_r) Reg
    dst_r

    genAddSubRetCarry
      :: Width
      -> (Format -> Operand -> Operand -> Instr)
      -> (Format -> Maybe (Operand -> Operand -> Instr))
      -> Cond
      -> LocalReg
      -> LocalReg
      -> CmmExpr
      -> CmmExpr
      -> NatM InstrBlock
    genAddSubRetCarry :: Width
    -> (Format -> Operand -> Operand -> Instr)
    -> (Format -> Maybe (Operand -> Operand -> Instr))
    -> Cond
    -> LocalReg
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genAddSubRetCarry Width
    width Format -> Operand -> Operand -> Instr
    instr Format -> Maybe (Operand -> Operand -> Instr)
    mrevinstr Cond
    cond LocalReg
    res_r LocalReg
    res_c CmmExpr
    arg_x CmmExpr
    arg_y = do
      Platform
    platform <- NCGConfig -> Platform
    ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NatM NCGConfig
    getConfig
      let format :: Format
    format = Width -> Format
    intFormat Width
    width
      Reg -> OrdList Instr
    rCode <- Register -> NatM (Reg -> OrdList Instr)
    anyReg (Register -> NatM (Reg -> OrdList Instr))
    -> NatM Register -> NatM (Reg -> OrdList Instr)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Width
    -> (Operand -> Operand -> Instr)
    -> Maybe (Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    width (Format -> Operand -> Operand -> Instr
    instr Format
    format)
                            (Format -> Maybe (Operand -> Operand -> Instr)
    mrevinstr Format
    format) CmmExpr
    arg_x CmmExpr
    arg_y
      Reg
    reg_tmp <- Format -> NatM Reg
    getNewRegNat Format
    II8
      let reg_c :: Reg
    reg_c = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform  (LocalReg -> CmmReg
    CmmLocal LocalReg
    res_c)
          reg_r :: Reg
    reg_r = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform  (LocalReg -> CmmReg
    CmmLocal LocalReg
    res_r)
          code :: OrdList Instr
    code = Reg -> OrdList Instr
    rCode Reg
    reg_r OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                 Cond -> Operand -> Instr
    SETCC Cond
    cond (Reg -> Operand
    OpReg Reg
    reg_tmp) OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                 Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II8 (Reg -> Operand
    OpReg Reg
    reg_tmp) (Reg -> Operand
    OpReg Reg
    reg_c)
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    code

    genAddWithCarry
      :: Width
      -> LocalReg
      -> LocalReg
      -> CmmExpr
      -> CmmExpr
      -> NatM InstrBlock
    genAddWithCarry :: Width
    -> LocalReg
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genAddWithCarry Width
    width LocalReg
    res_h LocalReg
    res_l CmmExpr
    arg_x CmmExpr
    arg_y = do
      Reg -> OrdList Instr
    hCode <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg (CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt Integer
    0 Width
    width))
      let format :: Format
    format = Width -> Format
    intFormat Width
    width
      Reg -> OrdList Instr
    lCode <- Register -> NatM (Reg -> OrdList Instr)
    anyReg (Register -> NatM (Reg -> OrdList Instr))
    -> NatM Register -> NatM (Reg -> OrdList Instr)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Width
    -> (Operand -> Operand -> Instr)
    -> Maybe (Operand -> Operand -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    width (Format -> Operand -> Operand -> Instr
    ADD_CC Format
    format)
                            ((Operand -> Operand -> Instr)
    -> Maybe (Operand -> Operand -> Instr)
    forall a. a -> Maybe a
    Just (Format -> Operand -> Operand -> Instr
    ADD_CC Format
    format)) CmmExpr
    arg_x CmmExpr
    arg_y
      let reg_l :: Reg
    reg_l = LocalReg -> Reg
    getLocalRegReg LocalReg
    res_l
          reg_h :: Reg
    reg_h = LocalReg -> Reg
    getLocalRegReg LocalReg
    res_h
          code :: OrdList Instr
    code = Reg -> OrdList Instr
    hCode Reg
    reg_h OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                 Reg -> OrdList Instr
    lCode Reg
    reg_l OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                 Format -> Operand -> Operand -> Instr
    ADC Format
    format (Imm -> Operand
    OpImm (Integer -> Imm
    ImmInteger Integer
    0)) (Reg -> Operand
    OpReg Reg
    reg_h)
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    code

    genSignedLargeMul
      :: Width
      -> LocalReg
      -> LocalReg
      -> LocalReg
      -> CmmExpr
      -> CmmExpr
      -> NatM (OrdList Instr)
    genSignedLargeMul :: Width
    -> LocalReg
    -> LocalReg
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genSignedLargeMul Width
    width LocalReg
    res_c LocalReg
    res_h LocalReg
    res_l CmmExpr
    arg_x CmmExpr
    arg_y = do
      (Operand
    y_reg, OrdList Instr
    y_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
    getRegOrMem CmmExpr
    arg_y
      Reg -> OrdList Instr
    x_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    arg_x
      Reg
    reg_tmp <- Format -> NatM Reg
    getNewRegNat Format
    II8
      let format :: Format
    format = Width -> Format
    intFormat Width
    width
          reg_h :: Reg
    reg_h = LocalReg -> Reg
    getLocalRegReg LocalReg
    res_h
          reg_l :: Reg
    reg_l = LocalReg -> Reg
    getLocalRegReg LocalReg
    res_l
          reg_c :: Reg
    reg_c = LocalReg -> Reg
    getLocalRegReg LocalReg
    res_c
          code :: OrdList Instr
    code = OrdList Instr
    y_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                 Reg -> OrdList Instr
    x_code Reg
    rax OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                 [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Format -> Operand -> Instr
    IMUL2 Format
    format Operand
    y_reg
                      , Format -> Operand -> Operand -> Instr
    MOV Format
    format (Reg -> Operand
    OpReg Reg
    rdx) (Reg -> Operand
    OpReg Reg
    reg_h)
                      , Format -> Operand -> Operand -> Instr
    MOV Format
    format (Reg -> Operand
    OpReg Reg
    rax) (Reg -> Operand
    OpReg Reg
    reg_l)
                      , Cond -> Operand -> Instr
    SETCC Cond
    CARRY (Reg -> Operand
    OpReg Reg
    reg_tmp)
                      , Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II8 (Reg -> Operand
    OpReg Reg
    reg_tmp) (Reg -> Operand
    OpReg Reg
    reg_c)
                      ]
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    code

    genUnsignedLargeMul
      :: Width
      -> LocalReg
      -> LocalReg
      -> CmmExpr
      -> CmmExpr
      -> NatM (OrdList Instr)
    genUnsignedLargeMul :: Width
    -> LocalReg
    -> LocalReg
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genUnsignedLargeMul Width
    width LocalReg
    res_h LocalReg
    res_l CmmExpr
    arg_x CmmExpr
    arg_y = do
      (Operand
    y_reg, OrdList Instr
    y_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
    getRegOrMem CmmExpr
    arg_y
      Reg -> OrdList Instr
    x_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    arg_x
      let format :: Format
    format = Width -> Format
    intFormat Width
    width
          reg_h :: Reg
    reg_h = LocalReg -> Reg
    getLocalRegReg LocalReg
    res_h
          reg_l :: Reg
    reg_l = LocalReg -> Reg
    getLocalRegReg LocalReg
    res_l
          code :: OrdList Instr
    code = OrdList Instr
    y_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                 Reg -> OrdList Instr
    x_code Reg
    rax OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                 [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [Format -> Operand -> Instr
    MUL2 Format
    format Operand
    y_reg,
                       Format -> Operand -> Operand -> Instr
    MOV Format
    format (Reg -> Operand
    OpReg Reg
    rdx) (Reg -> Operand
    OpReg Reg
    reg_h),
                       Format -> Operand -> Operand -> Instr
    MOV Format
    format (Reg -> Operand
    OpReg Reg
    rax) (Reg -> Operand
    OpReg Reg
    reg_l)]
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    code

    genQuotRem
      :: Width
      -> Bool
      -> LocalReg
      -> LocalReg
      -> Maybe CmmExpr
      -> CmmExpr
      -> CmmExpr
      -> NatM InstrBlock
    genQuotRem :: Width
    -> Bool
    -> LocalReg
    -> LocalReg
    -> Maybe CmmExpr
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genQuotRem Width
    width Bool
    signed LocalReg
    res_q LocalReg
    res_r Maybe CmmExpr
    m_arg_x_high CmmExpr
    arg_x_low CmmExpr
    arg_y = do
      case Width
    width of
        Width
    W8 -> do
          -- See Note [DIV/IDIV for bytes]
          let widen :: MachOp
    widen | Bool
    signed = Width -> Width -> MachOp
    MO_SS_Conv Width
    W8 Width
    W16
                    | Bool
    otherwise = Width -> Width -> MachOp
    MO_UU_Conv Width
    W8 Width
    W16
              arg_x_low_16 :: CmmExpr
    arg_x_low_16 = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp MachOp
    widen [CmmExpr
    arg_x_low]
              arg_y_16 :: CmmExpr
    arg_y_16 = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp MachOp
    widen [CmmExpr
    arg_y]
              m_arg_x_high_16 :: Maybe CmmExpr
    m_arg_x_high_16 = (\CmmExpr
    p -> MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp MachOp
    widen [CmmExpr
    p]) (CmmExpr -> CmmExpr) -> Maybe CmmExpr -> Maybe CmmExpr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe CmmExpr
    m_arg_x_high
          Width
    -> Bool
    -> LocalReg
    -> LocalReg
    -> Maybe CmmExpr
    -> CmmExpr
    -> CmmExpr
    -> NatM (OrdList Instr)
    genQuotRem Width
    W16 Bool
    signed LocalReg
    res_q LocalReg
    res_r Maybe CmmExpr
    m_arg_x_high_16 CmmExpr
    arg_x_low_16 CmmExpr
    arg_y_16

        Width
    _ -> do
          let format :: Format
    format = Width -> Format
    intFormat Width
    width
              reg_q :: Reg
    reg_q = LocalReg -> Reg
    getLocalRegReg LocalReg
    res_q
              reg_r :: Reg
    reg_r = LocalReg -> Reg
    getLocalRegReg LocalReg
    res_r
              widen :: Instr
    widen | Bool
    signed    = Format -> Instr
    CLTD Format
    format
                    | Bool
    otherwise = Format -> Operand -> Operand -> Instr
    XOR Format
    format (Reg -> Operand
    OpReg Reg
    rdx) (Reg -> Operand
    OpReg Reg
    rdx)
              instr :: Format -> Operand -> Instr
    instr | Bool
    signed    = Format -> Operand -> Instr
    IDIV
                    | Bool
    otherwise = Format -> Operand -> Instr
    DIV
          (Operand
    y_reg, OrdList Instr
    y_code) <- CmmExpr -> NatM (Operand, OrdList Instr)
    getRegOrMem CmmExpr
    arg_y
          Reg -> OrdList Instr
    x_low_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    arg_x_low
          Reg -> OrdList Instr
    x_high_code <- case Maybe CmmExpr
    m_arg_x_high of
                         Just CmmExpr
    arg_x_high ->
                             CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    arg_x_high
                         Maybe CmmExpr
    Nothing ->
                             (Reg -> OrdList Instr) -> NatM (Reg -> OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Reg -> OrdList Instr) -> NatM (Reg -> OrdList Instr))
    -> (Reg -> OrdList Instr) -> NatM (Reg -> OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr -> Reg -> OrdList Instr
    forall a b. a -> b -> a
    const (OrdList Instr -> Reg -> OrdList Instr)
    -> OrdList Instr -> Reg -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL Instr
    widen
          OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    y_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                   Reg -> OrdList Instr
    x_low_code Reg
    rax OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                   Reg -> OrdList Instr
    x_high_code Reg
    rdx OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                   [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [Format -> Operand -> Instr
    instr Format
    format Operand
    y_reg,
                         Format -> Operand -> Operand -> Instr
    MOV Format
    format (Reg -> Operand
    OpReg Reg
    rax) (Reg -> Operand
    OpReg Reg
    reg_q),
                         Format -> Operand -> Operand -> Instr
    MOV Format
    format (Reg -> Operand
    OpReg Reg
    rdx) (Reg -> Operand
    OpReg Reg
    reg_r)]

    ----------------------------------------------------------------------------
    -- The following functions implement certain 64-bit MachOps inline for 32-bit
    -- architectures. On 64-bit architectures, those MachOps aren't supported and
    -- calling these functions for a 64-bit target platform is considered an error
    -- (hence the use of `expect32BitPlatform`).
    --
    -- On 64-bit platforms, generic MachOps should be used instead of these 64-bit
    -- specific ones (e.g. use MO_Add instead of MO_x64_Add). This MachOp selection
    -- is done by StgToCmm.

    genInt64ToInt :: LocalReg -> CmmExpr -> NatM InstrBlock
    genInt64ToInt :: LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genInt64ToInt LocalReg
    dst CmmExpr
    src = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genInt64ToInt")
      RegCode64 OrdList Instr
    code Reg
    _src_hi Reg
    src_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    src
      let dst_r :: Reg
    dst_r = LocalReg -> Reg
    getLocalRegReg LocalReg
    dst
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    src_lo) (Reg -> Operand
    OpReg Reg
    dst_r)

    genWord64ToWord :: LocalReg -> CmmExpr -> NatM InstrBlock
    genWord64ToWord :: LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genWord64ToWord LocalReg
    dst CmmExpr
    src = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genWord64ToWord")
      RegCode64 OrdList Instr
    code Reg
    _src_hi Reg
    src_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    src
      let dst_r :: Reg
    dst_r = LocalReg -> Reg
    getLocalRegReg LocalReg
    dst
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    src_lo) (Reg -> Operand
    OpReg Reg
    dst_r)

    genIntToInt64 :: LocalReg -> CmmExpr -> NatM InstrBlock
    genIntToInt64 :: LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genIntToInt64 LocalReg
    dst CmmExpr
    src = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genIntToInt64")
      let Reg64 Reg
    dst_hi Reg
    dst_lo = (() :: Constraint) => LocalReg -> Reg64
    LocalReg -> Reg64
    localReg64 LocalReg
    dst
      Reg -> OrdList Instr
    src_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    src
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Reg -> OrdList Instr
    src_code Reg
    rax OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
              [ Format -> Instr
    CLTD Format
    II32 -- sign extend EAX in EDX:EAX
              , Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    rax) (Reg -> Operand
    OpReg Reg
    dst_lo)
              , Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    rdx) (Reg -> Operand
    OpReg Reg
    dst_hi)
              ]

    genWordToWord64 :: LocalReg -> CmmExpr -> NatM InstrBlock
    genWordToWord64 :: LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genWordToWord64 LocalReg
    dst CmmExpr
    src = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genWordToWord64")
      let Reg64 Reg
    dst_hi Reg
    dst_lo = (() :: Constraint) => LocalReg -> Reg64
    LocalReg -> Reg64
    localReg64 LocalReg
    dst
      Reg -> OrdList Instr
    src_code <- CmmExpr -> NatM (Reg -> OrdList Instr)
    getAnyReg CmmExpr
    src
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ Reg -> OrdList Instr
    src_code Reg
    dst_lo
              OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Operand -> Operand -> Instr
    XOR Format
    II32 (Reg -> Operand
    OpReg Reg
    dst_hi) (Reg -> Operand
    OpReg Reg
    dst_hi)

    genNeg64 :: LocalReg -> CmmExpr -> NatM InstrBlock
    genNeg64 :: LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genNeg64 LocalReg
    dst CmmExpr
    src = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genNeg64")
      let Reg64 Reg
    dst_hi Reg
    dst_lo = (() :: Constraint) => LocalReg -> Reg64
    LocalReg -> Reg64
    localReg64 LocalReg
    dst
      RegCode64 OrdList Instr
    code Reg
    src_hi Reg
    src_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    src
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
              [ Format -> Operand -> Operand -> Instr
    MOV  Format
    II32 (Reg -> Operand
    OpReg Reg
    src_lo) (Reg -> Operand
    OpReg Reg
    dst_lo)
              , Format -> Operand -> Operand -> Instr
    MOV  Format
    II32 (Reg -> Operand
    OpReg Reg
    src_hi) (Reg -> Operand
    OpReg Reg
    dst_hi)
              , Format -> Operand -> Instr
    NEGI Format
    II32 (Reg -> Operand
    OpReg Reg
    dst_lo)
              , Format -> Operand -> Operand -> Instr
    ADC  Format
    II32 (Imm -> Operand
    OpImm (Int -> Imm
    ImmInt Int
    0)) (Reg -> Operand
    OpReg Reg
    dst_hi)
              , Format -> Operand -> Instr
    NEGI Format
    II32 (Reg -> Operand
    OpReg Reg
    dst_hi)
              ]

    genAdd64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genAdd64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genAdd64 LocalReg
    dst CmmExpr
    x CmmExpr
    y = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genAdd64")
      let Reg64 Reg
    dst_hi Reg
    dst_lo = (() :: Constraint) => LocalReg -> Reg64
    LocalReg -> Reg64
    localReg64 LocalReg
    dst
      RegCode64 OrdList Instr
    x_code Reg
    x_hi Reg
    x_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
      RegCode64 OrdList Instr
    y_code Reg
    y_hi Reg
    y_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    y
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    x_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    y_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
              [ Format -> Operand -> Operand -> Instr
    MOV  Format
    II32 (Reg -> Operand
    OpReg Reg
    x_lo) (Reg -> Operand
    OpReg Reg
    dst_lo)
              , Format -> Operand -> Operand -> Instr
    MOV  Format
    II32 (Reg -> Operand
    OpReg Reg
    x_hi) (Reg -> Operand
    OpReg Reg
    dst_hi)
              , Format -> Operand -> Operand -> Instr
    ADD  Format
    II32 (Reg -> Operand
    OpReg Reg
    y_lo) (Reg -> Operand
    OpReg Reg
    dst_lo)
              , Format -> Operand -> Operand -> Instr
    ADC  Format
    II32 (Reg -> Operand
    OpReg Reg
    y_hi) (Reg -> Operand
    OpReg Reg
    dst_hi)
              ]

    genSub64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genSub64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genSub64 LocalReg
    dst CmmExpr
    x CmmExpr
    y = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genSub64")
      let Reg64 Reg
    dst_hi Reg
    dst_lo = (() :: Constraint) => LocalReg -> Reg64
    LocalReg -> Reg64
    localReg64 LocalReg
    dst
      RegCode64 OrdList Instr
    x_code Reg
    x_hi Reg
    x_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
      RegCode64 OrdList Instr
    y_code Reg
    y_hi Reg
    y_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    y
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    x_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    y_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
              [ Format -> Operand -> Operand -> Instr
    MOV  Format
    II32 (Reg -> Operand
    OpReg Reg
    x_lo) (Reg -> Operand
    OpReg Reg
    dst_lo)
              , Format -> Operand -> Operand -> Instr
    MOV  Format
    II32 (Reg -> Operand
    OpReg Reg
    x_hi) (Reg -> Operand
    OpReg Reg
    dst_hi)
              , Format -> Operand -> Operand -> Instr
    SUB  Format
    II32 (Reg -> Operand
    OpReg Reg
    y_lo) (Reg -> Operand
    OpReg Reg
    dst_lo)
              , Format -> Operand -> Operand -> Instr
    SBB  Format
    II32 (Reg -> Operand
    OpReg Reg
    y_hi) (Reg -> Operand
    OpReg Reg
    dst_hi)
              ]

    genAnd64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genAnd64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genAnd64 LocalReg
    dst CmmExpr
    x CmmExpr
    y = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genAnd64")
      let Reg64 Reg
    dst_hi Reg
    dst_lo = (() :: Constraint) => LocalReg -> Reg64
    LocalReg -> Reg64
    localReg64 LocalReg
    dst
      RegCode64 OrdList Instr
    x_code Reg
    x_hi Reg
    x_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
      RegCode64 OrdList Instr
    y_code Reg
    y_hi Reg
    y_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    y
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    x_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    y_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
              [ Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    x_lo) (Reg -> Operand
    OpReg Reg
    dst_lo)
              , Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    x_hi) (Reg -> Operand
    OpReg Reg
    dst_hi)
              , Format -> Operand -> Operand -> Instr
    AND Format
    II32 (Reg -> Operand
    OpReg Reg
    y_lo) (Reg -> Operand
    OpReg Reg
    dst_lo)
              , Format -> Operand -> Operand -> Instr
    AND Format
    II32 (Reg -> Operand
    OpReg Reg
    y_hi) (Reg -> Operand
    OpReg Reg
    dst_hi)
              ]

    genOr64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genOr64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genOr64 LocalReg
    dst CmmExpr
    x CmmExpr
    y = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genOr64")
      let Reg64 Reg
    dst_hi Reg
    dst_lo = (() :: Constraint) => LocalReg -> Reg64
    LocalReg -> Reg64
    localReg64 LocalReg
    dst
      RegCode64 OrdList Instr
    x_code Reg
    x_hi Reg
    x_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
      RegCode64 OrdList Instr
    y_code Reg
    y_hi Reg
    y_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    y
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    x_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    y_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
              [ Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    x_lo) (Reg -> Operand
    OpReg Reg
    dst_lo)
              , Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    x_hi) (Reg -> Operand
    OpReg Reg
    dst_hi)
              , Format -> Operand -> Operand -> Instr
    OR  Format
    II32 (Reg -> Operand
    OpReg Reg
    y_lo) (Reg -> Operand
    OpReg Reg
    dst_lo)
              , Format -> Operand -> Operand -> Instr
    OR  Format
    II32 (Reg -> Operand
    OpReg Reg
    y_hi) (Reg -> Operand
    OpReg Reg
    dst_hi)
              ]

    genXor64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genXor64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genXor64 LocalReg
    dst CmmExpr
    x CmmExpr
    y = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genXor64")
      let Reg64 Reg
    dst_hi Reg
    dst_lo = (() :: Constraint) => LocalReg -> Reg64
    LocalReg -> Reg64
    localReg64 LocalReg
    dst
      RegCode64 OrdList Instr
    x_code Reg
    x_hi Reg
    x_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
      RegCode64 OrdList Instr
    y_code Reg
    y_hi Reg
    y_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    y
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    x_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    y_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
              [ Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    x_lo) (Reg -> Operand
    OpReg Reg
    dst_lo)
              , Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    x_hi) (Reg -> Operand
    OpReg Reg
    dst_hi)
              , Format -> Operand -> Operand -> Instr
    XOR Format
    II32 (Reg -> Operand
    OpReg Reg
    y_lo) (Reg -> Operand
    OpReg Reg
    dst_lo)
              , Format -> Operand -> Operand -> Instr
    XOR Format
    II32 (Reg -> Operand
    OpReg Reg
    y_hi) (Reg -> Operand
    OpReg Reg
    dst_hi)
              ]

    genNot64 :: LocalReg -> CmmExpr -> NatM InstrBlock
    genNot64 :: LocalReg -> CmmExpr -> NatM (OrdList Instr)
    genNot64 LocalReg
    dst CmmExpr
    src = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genNot64")
      let Reg64 Reg
    dst_hi Reg
    dst_lo = (() :: Constraint) => LocalReg -> Reg64
    LocalReg -> Reg64
    localReg64 LocalReg
    dst
      RegCode64 OrdList Instr
    src_code Reg
    src_hi Reg
    src_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    src
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    src_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
              [ Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    src_lo) (Reg -> Operand
    OpReg Reg
    dst_lo)
              , Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    src_hi) (Reg -> Operand
    OpReg Reg
    dst_hi)
              , Format -> Operand -> Instr
    NOT Format
    II32 (Reg -> Operand
    OpReg Reg
    dst_lo)
              , Format -> Operand -> Instr
    NOT Format
    II32 (Reg -> Operand
    OpReg Reg
    dst_hi)
              ]

    genEq64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genEq64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genEq64 LocalReg
    dst CmmExpr
    x CmmExpr
    y = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genEq64")
      let dst_r :: Reg
    dst_r = LocalReg -> Reg
    getLocalRegReg LocalReg
    dst
      RegCode64 OrdList Instr
    x_code Reg
    x_hi Reg
    x_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
      RegCode64 OrdList Instr
    y_code Reg
    y_hi Reg
    y_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    y
      Reg64 Reg
    tmp_hi Reg
    tmp_lo <- NatM Reg64
    getNewReg64
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    x_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    y_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
              [ Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    x_lo)   (Reg -> Operand
    OpReg Reg
    tmp_lo)
              , Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    x_hi)   (Reg -> Operand
    OpReg Reg
    tmp_hi)
              , Format -> Operand -> Operand -> Instr
    XOR Format
    II32 (Reg -> Operand
    OpReg Reg
    y_lo)   (Reg -> Operand
    OpReg Reg
    tmp_lo)
              , Format -> Operand -> Operand -> Instr
    XOR Format
    II32 (Reg -> Operand
    OpReg Reg
    y_hi)   (Reg -> Operand
    OpReg Reg
    tmp_hi)
              , Format -> Operand -> Operand -> Instr
    OR  Format
    II32 (Reg -> Operand
    OpReg Reg
    tmp_lo) (Reg -> Operand
    OpReg Reg
    tmp_hi)
              , Cond -> Operand -> Instr
    SETCC Cond
    EQQ (Reg -> Operand
    OpReg Reg
    dst_r)
              , Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II8 (Reg -> Operand
    OpReg Reg
    dst_r) (Reg -> Operand
    OpReg Reg
    dst_r)
              ]

    genNe64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genNe64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genNe64 LocalReg
    dst CmmExpr
    x CmmExpr
    y = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genNe64")
      let dst_r :: Reg
    dst_r = LocalReg -> Reg
    getLocalRegReg LocalReg
    dst
      RegCode64 OrdList Instr
    x_code Reg
    x_hi Reg
    x_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
      RegCode64 OrdList Instr
    y_code Reg
    y_hi Reg
    y_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    y
      Reg64 Reg
    tmp_hi Reg
    tmp_lo <- NatM Reg64
    getNewReg64
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    x_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    y_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
              [ Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    x_lo)   (Reg -> Operand
    OpReg Reg
    tmp_lo)
              , Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    x_hi)   (Reg -> Operand
    OpReg Reg
    tmp_hi)
              , Format -> Operand -> Operand -> Instr
    XOR Format
    II32 (Reg -> Operand
    OpReg Reg
    y_lo)   (Reg -> Operand
    OpReg Reg
    tmp_lo)
              , Format -> Operand -> Operand -> Instr
    XOR Format
    II32 (Reg -> Operand
    OpReg Reg
    y_hi)   (Reg -> Operand
    OpReg Reg
    tmp_hi)
              , Format -> Operand -> Operand -> Instr
    OR  Format
    II32 (Reg -> Operand
    OpReg Reg
    tmp_lo) (Reg -> Operand
    OpReg Reg
    tmp_hi)
              , Cond -> Operand -> Instr
    SETCC Cond
    NE (Reg -> Operand
    OpReg Reg
    dst_r)
              , Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II8 (Reg -> Operand
    OpReg Reg
    dst_r) (Reg -> Operand
    OpReg Reg
    dst_r)
              ]

    genGtWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genGtWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genGtWord64 LocalReg
    dst CmmExpr
    x CmmExpr
    y = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genGtWord64")
      Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genPred64 Cond
    LU LocalReg
    dst CmmExpr
    y CmmExpr
    x

    genLtWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genLtWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genLtWord64 LocalReg
    dst CmmExpr
    x CmmExpr
    y = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genLtWord64")
      Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genPred64 Cond
    LU LocalReg
    dst CmmExpr
    x CmmExpr
    y

    genGeWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genGeWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genGeWord64 LocalReg
    dst CmmExpr
    x CmmExpr
    y = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genGeWord64")
      Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genPred64 Cond
    GEU LocalReg
    dst CmmExpr
    x CmmExpr
    y

    genLeWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genLeWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genLeWord64 LocalReg
    dst CmmExpr
    x CmmExpr
    y = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genLeWord64")
      Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genPred64 Cond
    GEU LocalReg
    dst CmmExpr
    y CmmExpr
    x

    genGtInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genGtInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genGtInt64 LocalReg
    dst CmmExpr
    x CmmExpr
    y = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genGtInt64")
      Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genPred64 Cond
    LTT LocalReg
    dst CmmExpr
    y CmmExpr
    x

    genLtInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genLtInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genLtInt64 LocalReg
    dst CmmExpr
    x CmmExpr
    y = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genLtInt64")
      Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genPred64 Cond
    LTT LocalReg
    dst CmmExpr
    x CmmExpr
    y

    genGeInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genGeInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genGeInt64 LocalReg
    dst CmmExpr
    x CmmExpr
    y = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genGeInt64")
      Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genPred64 Cond
    GE LocalReg
    dst CmmExpr
    x CmmExpr
    y

    genLeInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genLeInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genLeInt64 LocalReg
    dst CmmExpr
    x CmmExpr
    y = do
      SDoc -> NatM ()
    expect32BitPlatform (String -> SDoc
    text String
    "genLeInt64")
      Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genPred64 Cond
    GE LocalReg
    dst CmmExpr
    y CmmExpr
    x

    genPred64 :: Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
    genPred64 :: Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    genPred64 Cond
    cond LocalReg
    dst CmmExpr
    x CmmExpr
    y = do
      -- we can only rely on CF/SF/OF flags!
      -- Not on ZF, which doesn't take into account the lower parts.
      Bool -> NatM ()
    forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
    massert (Cond
    cond Cond -> [Cond] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Cond
    LU,Cond
    GEU,Cond
    LTT,Cond
    GE])

      let dst_r :: Reg
    dst_r = LocalReg -> Reg
    getLocalRegReg LocalReg
    dst
      RegCode64 OrdList Instr
    x_code Reg
    x_hi Reg
    x_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
      RegCode64 OrdList Instr
    y_code Reg
    y_hi Reg
    y_lo <- (() :: Constraint) => CmmExpr -> NatM (RegCode64 (OrdList Instr))
    CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    y
      -- Basically we perform a subtraction with borrow.
      -- As we don't need to result, we can use CMP instead of SUB for the low part
      -- (it sets the borrow flag just like SUB does)
      OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrdList Instr -> NatM (OrdList Instr))
    -> OrdList Instr -> NatM (OrdList Instr)
    forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    x_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    y_code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
              [ Format -> Operand -> Operand -> Instr
    MOV Format
    II32 (Reg -> Operand
    OpReg Reg
    x_hi) (Reg -> Operand
    OpReg Reg
    dst_r)
              , Format -> Operand -> Operand -> Instr
    CMP Format
    II32 (Reg -> Operand
    OpReg Reg
    y_lo) (Reg -> Operand
    OpReg Reg
    x_lo)
              , Format -> Operand -> Operand -> Instr
    SBB Format
    II32 (Reg -> Operand
    OpReg Reg
    y_hi) (Reg -> Operand
    OpReg Reg
    dst_r)
              , Cond -> Operand -> Instr
    SETCC Cond
    cond (Reg -> Operand
    OpReg Reg
    dst_r)
              , Format -> Operand -> Operand -> Instr
    MOVZxL Format
    II8 (Reg -> Operand
    OpReg Reg
    dst_r) (Reg -> Operand
    OpReg Reg
    dst_r)
              ]