    {-# LANGUAGE GADTs #-}

    -----------------------------------------------------------------------------
    --
    -- 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.PPC.CodeGen (
            cmmTopCodeGen,
            generateJumpTableForInstr,
            InstrBlock
    )

    where

    -- NCG stuff:
    import GHC.Prelude

    import GHC.Platform.Regs
    import GHC.CmmToAsm.PPC.Instr
    import GHC.CmmToAsm.PPC.Cond
    import GHC.CmmToAsm.PPC.Regs
    import GHC.CmmToAsm.CPrim
    import GHC.CmmToAsm.Types
    import GHC.Cmm.DebugBlock
       ( DebugBlock(..) )
    import GHC.CmmToAsm.Monad
       ( NatM, getNewRegNat, getNewLabelNat
       , getBlockIdNat, getPicBaseNat
       , Reg64(..), RegCode64(..), getNewReg64, localReg64
       , getPicBaseMaybeNat, getPlatform, getConfig
       , getDebugBlock, getFileId
       )
    import GHC.CmmToAsm.PIC
    import GHC.CmmToAsm.Format
    import GHC.CmmToAsm.Config
    import GHC.Platform.Reg.Class
    import GHC.Platform.Reg
    import GHC.CmmToAsm.Reg.Target
    import GHC.Platform

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

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

    import Control.Monad    ( mapAndUnzipM, when )
    import Data.Word

    import GHC.Types.Basic
    import GHC.Data.FastString

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

    -- | '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 (pre-order?) yields the insns in the correct
    -- order.

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

    cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl RawCmmStatics Instr]
    cmmTopCodeGen (CmmProc LabelMap RawCmmStatics
    info CLabel
    lab [GlobalReg]
    live CmmGraph
    graph) = do
      let blocks :: [CmmBlock]
    blocks = CmmGraph -> [CmmBlock]
    toBlockListEntryFirst CmmGraph
    graph
      (nat_blocks,statics) <- (CmmBlock
     -> NatM ([NatBasicBlock Instr], [NatCmmDecl RawCmmStatics Instr]))
    -> [CmmBlock]
    -> NatM
         ([[NatBasicBlock Instr]], [[NatCmmDecl RawCmmStatics Instr]])
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> m (b, c)) -> [a] -> m ([b], [c])
    mapAndUnzipM CmmBlock
    -> NatM ([NatBasicBlock Instr], [NatCmmDecl RawCmmStatics Instr])
    basicBlockCodeGen [CmmBlock]
    blocks
      platform <- getPlatform
      let proc = LabelMap RawCmmStatics
    -> CLabel
    -> [GlobalReg]
    -> ListGraph Instr
    -> NatCmmDecl RawCmmStatics Instr
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc LabelMap RawCmmStatics
    info CLabel
    lab [GlobalReg]
    live ([NatBasicBlock Instr] -> ListGraph Instr
    forall i. [GenBasicBlock i] -> ListGraph i
    ListGraph ([NatBasicBlock Instr] -> ListGraph Instr)
    -> [NatBasicBlock Instr] -> ListGraph Instr
    forall a b. (a -> b) -> a -> b
    $ [[NatBasicBlock Instr]] -> [NatBasicBlock Instr]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[NatBasicBlock Instr]]
    nat_blocks)
          tops = NatCmmDecl RawCmmStatics Instr
    proc NatCmmDecl RawCmmStatics Instr
    -> [NatCmmDecl RawCmmStatics Instr]
    -> [NatCmmDecl RawCmmStatics Instr]
    forall a. a -> [a] -> [a]
    : [[NatCmmDecl RawCmmStatics Instr]]
    -> [NatCmmDecl RawCmmStatics Instr]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[NatCmmDecl RawCmmStatics Instr]]
    statics
          os   = Platform -> OS
    platformOS Platform
    platform
          arch = Platform -> Arch
    platformArch Platform
    platform
      case arch of
        Arch
    ArchPPC | OS
    os OS -> OS -> Bool
    forall a. Eq a => a -> a -> Bool
    == OS
    OSAIX -> [NatCmmDecl RawCmmStatics Instr]
    -> NatM [NatCmmDecl RawCmmStatics Instr]
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [NatCmmDecl RawCmmStatics Instr]
    tops
                | Bool
    otherwise -> do
          picBaseMb <- NatM (Maybe Reg)
    getPicBaseMaybeNat
          case picBaseMb of
               Just Reg
    picBase -> Arch
    -> OS
    -> Reg
    -> [NatCmmDecl RawCmmStatics Instr]
    -> NatM [NatCmmDecl RawCmmStatics Instr]
    initializePicBase_ppc Arch
    arch OS
    os Reg
    picBase [NatCmmDecl RawCmmStatics Instr]
    tops
               Maybe Reg
    Nothing -> [NatCmmDecl RawCmmStatics Instr]
    -> NatM [NatCmmDecl RawCmmStatics Instr]
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [NatCmmDecl RawCmmStatics Instr]
    tops
        ArchPPC_64 PPC_64ABI
    ELF_V1 -> [NatCmmDecl RawCmmStatics Instr]
    -> NatM [NatCmmDecl RawCmmStatics Instr]
    forall {m :: * -> *} {d} {h} {i}.
    MonadUnique m =>
    [GenCmmDecl d h (ListGraph i)] -> m [GenCmmDecl d h (ListGraph i)]
    fixup_entry [NatCmmDecl RawCmmStatics Instr]
    tops
                          -- generating function descriptor is handled in
                          -- pretty printer
        ArchPPC_64 PPC_64ABI
    ELF_V2 -> [NatCmmDecl RawCmmStatics Instr]
    -> NatM [NatCmmDecl RawCmmStatics Instr]
    forall {m :: * -> *} {d} {h} {i}.
    MonadUnique m =>
    [GenCmmDecl d h (ListGraph i)] -> m [GenCmmDecl d h (ListGraph i)]
    fixup_entry [NatCmmDecl RawCmmStatics Instr]
    tops
                          -- generating function prologue is handled in
                          -- pretty printer
        Arch
    _          -> String -> NatM [NatCmmDecl RawCmmStatics Instr]
    forall a. HasCallStack => String -> a
    panic String
    "PPC.cmmTopCodeGen: unknown arch"
        where
          fixup_entry :: [GenCmmDecl d h (ListGraph i)] -> m [GenCmmDecl d h (ListGraph i)]
    fixup_entry (CmmProc h
    info CLabel
    lab [GlobalReg]
    live (ListGraph (GenBasicBlock i
    entry:[GenBasicBlock i]
    blocks)) : [GenCmmDecl d h (ListGraph i)]
    statics)
            = do
            let BasicBlock BlockId
    bID [i]
    insns = GenBasicBlock i
    entry
            bID' <- if CLabel
    lab CLabel -> CLabel -> Bool
    forall a. Eq a => a -> a -> Bool
    == (BlockId -> CLabel
    blockLbl BlockId
    bID)
                    then m BlockId
    forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
                    else BlockId -> m BlockId
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return BlockId
    bID
            let b' = BlockId -> [i] -> GenBasicBlock i
    forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    bID' [i]
    insns
            return (CmmProc info lab live (ListGraph (b':blocks)) : statics)
          fixup_entry [GenCmmDecl d h (ListGraph i)]
    _ = String -> m [GenCmmDecl d h (ListGraph i)]
    forall a. HasCallStack => String -> a
    panic String
    "cmmTopCodegen: Broken CmmProc"

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

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

    basicBlockCodeGen :: CmmBlock
    -> NatM ([NatBasicBlock Instr], [NatCmmDecl 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 :: BlockId
    id = CmmBlock -> BlockId
    forall (x :: Extensibility). Block CmmNode C x -> BlockId
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> BlockId
    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
      dbg <- BlockId -> NatM (Maybe DebugBlock)
    getDebugBlock (CmmBlock -> BlockId
    forall (x :: Extensibility). Block CmmNode C x -> BlockId
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> BlockId
    entryLabel CmmBlock
    block)
      loc_instrs <- case dblSourceTick =<< dbg of
        Just (SourceNote RealSrcSpan
    span (LexicalFastString FastString
    name))
          -> do fileid <- FastString -> NatM Int
    getFileId (RealSrcSpan -> FastString
    srcSpanFile RealSrcSpan
    span)
                let line = RealSrcSpan -> Int
    srcSpanStartLine RealSrcSpan
    span; col =RealSrcSpan -> Int
    srcSpanStartCol RealSrcSpan
    span
                return $ unitOL $ LOCATION fileid line col (unpackFS name)
        Maybe CmmTickish
    _ -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    forall a. OrdList a
    nilOL
      mid_instrs <- stmtsToInstrs stmts
      tail_instrs <- stmtToInstrs tail
      let 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
      -- 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
            (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs

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

    stmtsToInstrs :: [CmmNode e x] -> NatM InstrBlock
    stmtsToInstrs :: forall (e :: Extensibility) (x :: Extensibility).
    [CmmNode e x] -> NatM (OrdList Instr)
    stmtsToInstrs [CmmNode e x]
    stmts
       = do instrss <- (CmmNode e x -> NatM (OrdList Instr))
    -> [CmmNode e x] -> NatM [OrdList Instr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM CmmNode e x -> NatM (OrdList Instr)
    forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> NatM (OrdList Instr)
    stmtToInstrs [CmmNode e x]
    stmts
            return (concatOL instrss)

    stmtToInstrs :: CmmNode e x -> NatM InstrBlock
    stmtToInstrs :: forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> NatM (OrdList Instr)
    stmtToInstrs CmmNode e x
    stmt = do
      config <- NatM NCGConfig
    getConfig
      platform <- getPlatform
      case stmt of
        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 (FastString -> Instr
    COMMENT 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 {}   -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    forall a. OrdList a
    nilOL

        CmmAssign CmmReg
    reg CmmExpr
    src
          | CmmType -> Bool
    isFloatType CmmType
    ty -> Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_FltCode Format
    format CmmReg
    reg CmmExpr
    src
          | Platform -> Bool
    target32Bit Platform
    platform 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 = CmmReg -> CmmType
    cmmRegType CmmReg
    reg
                  format :: Format
    format = CmmType -> Format
    cmmTypeFormat CmmType
    ty

        CmmStore CmmExpr
    addr CmmExpr
    src AlignmentSpec
    _alignment
          | CmmType -> Bool
    isFloatType CmmType
    ty -> Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_FltCode Format
    format CmmExpr
    addr CmmExpr
    src
          | Platform -> Bool
    target32Bit Platform
    platform 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

        CmmUnsafeForeignCall ForeignTarget
    target [CmmFormal]
    result_regs [CmmExpr]
    args
           -> ForeignTarget -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    genCCall ForeignTarget
    target [CmmFormal]
    result_regs [CmmExpr]
    args

        CmmBranch BlockId
    id          -> BlockId -> NatM (OrdList Instr)
    genBranch BlockId
    id
        CmmCondBranch CmmExpr
    arg BlockId
    true BlockId
    false Maybe Bool
    prediction -> do
          b1 <- BlockId -> CmmExpr -> Maybe Bool -> NatM (OrdList Instr)
    genCondJump BlockId
    true CmmExpr
    arg Maybe Bool
    prediction
          b2 <- genBranch false
          return (b1 `appOL` b2)
        CmmSwitch CmmExpr
    arg SwitchTargets
    ids -> NCGConfig -> CmmExpr -> SwitchTargets -> NatM (OrdList Instr)
    genSwitch NCGConfig
    config CmmExpr
    arg SwitchTargets
    ids
        CmmCall { cml_target :: CmmNode O C -> CmmExpr
    cml_target = CmmExpr
    arg
                , 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. HasCallStack => 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

    -- | 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 :: CmmFormal -> Reg
    getLocalRegReg (LocalReg Unique
    u CmmType
    pk)
      = 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 CmmFormal
    local_reg)
      = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    local_reg

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

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

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

    -- Expand CmmRegOff.  ToDo: should we do it this way around, or convert
    -- CmmExprs into CmmRegOff?
    mangleIndexTree :: CmmExpr -> CmmExpr
    mangleIndexTree :: CmmExpr -> CmmExpr
    mangleIndexTree (CmmRegOff 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 (CmmReg -> CmmType
    cmmRegType CmmReg
    reg)

    mangleIndexTree CmmExpr
    _
            = String -> CmmExpr
    forall a. HasCallStack => String -> a
    panic String
    "PPC.CodeGen.mangleIndexTree: no match"

    -- -----------------------------------------------------------------------------
    --  Code gen for 64-bit arithmetic on 32-bit platforms

    {-
    Simple support for generating 64-bit code (ie, 64 bit values and 64
    bit assignments) on 32-bit platforms.  Unlike the main code generator
    we merely shoot for generating working code as simply as possible, and
    pay little attention to code quality.  Specifically, there is no
    attempt to deal cleverly with the fixed-vs-floating register
    distinction; all values are generated into (pairs of) floating
    registers, even if this would mean some redundant reg-reg moves as a
    result.  Only one of the VRegUniques is returned, since it will be
    of the VRegUniqueLo form, and the upper-half VReg can be determined
    by applying getHiVRegFromLo to it.
    -}

    -- | 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
      r <- CmmExpr -> NatM Register
    getRegister CmmExpr
    expr
      case r of
        Any Format
    rep Reg -> OrdList Instr
    code -> do
            tmp <- Format -> NatM Reg
    getNewRegNat Format
    rep
            return (tmp, code 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)

    getI64Amodes :: CmmExpr -> NatM (AddrMode, AddrMode, InstrBlock)
    getI64Amodes :: CmmExpr -> NatM (AddrMode, AddrMode, OrdList Instr)
    getI64Amodes CmmExpr
    addrTree = do
        Amode hi_addr addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    addrTree
        case addrOffset hi_addr 4 of
            Just AddrMode
    lo_addr -> (AddrMode, AddrMode, OrdList Instr)
    -> NatM (AddrMode, AddrMode, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode
    hi_addr, AddrMode
    lo_addr, OrdList Instr
    addr_code)
            Maybe AddrMode
    Nothing      -> do (hi_ptr, code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    addrTree
                               return (AddrRegImm hi_ptr (ImmInt 0),
                                       AddrRegImm hi_ptr (ImmInt 4),
                                       code)

    assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
    assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_I64Code CmmExpr
    addrTree CmmExpr
    valueTree = do
            (hi_addr, lo_addr, addr_code) <- CmmExpr -> NatM (AddrMode, AddrMode, OrdList Instr)
    getI64Amodes CmmExpr
    addrTree
            RegCode64 vcode rhi rlo <- iselExpr64 valueTree
            let
                    -- Big-endian store
                    mov_hi = Format -> Reg -> AddrMode -> Instr
    ST Format
    II32 Reg
    rhi AddrMode
    hi_addr
                    mov_lo = Format -> Reg -> AddrMode -> Instr
    ST Format
    II32 Reg
    rlo AddrMode
    lo_addr
            return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)

    assignReg_I64Code :: CmmReg  -> CmmExpr -> NatM InstrBlock
    assignReg_I64Code :: CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_I64Code (CmmLocal CmmFormal
    lreg) CmmExpr
    valueTree = do
       RegCode64 vcode r_src_hi r_src_lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    valueTree
       let Reg64 r_dst_hi r_dst_lo = localReg64 lreg
           mov_lo = Reg -> Reg -> Instr
    MR Reg
    r_dst_lo Reg
    r_src_lo
           mov_hi = Reg -> Reg -> Instr
    MR Reg
    r_dst_hi Reg
    r_src_hi
       return (
            vcode `snocOL` mov_lo `snocOL` mov_hi
         )

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

    iselExpr64        :: CmmExpr -> NatM (RegCode64 InstrBlock)
    iselExpr64 :: CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 (CmmLoad CmmExpr
    addrTree CmmType
    ty AlignmentSpec
    _) | CmmType -> Bool
    isWord64 CmmType
    ty = do
        (hi_addr, lo_addr, addr_code) <- CmmExpr -> NatM (AddrMode, AddrMode, OrdList Instr)
    getI64Amodes CmmExpr
    addrTree
        Reg64 rhi rlo <- getNewReg64
        let mov_hi = Format -> Reg -> AddrMode -> Instr
    LD Format
    II32 Reg
    rhi AddrMode
    hi_addr
            mov_lo = Format -> Reg -> AddrMode -> Instr
    LD Format
    II32 Reg
    rlo AddrMode
    lo_addr
        return $ RegCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
                             rhi rlo

    iselExpr64 (CmmReg (CmmLocal CmmFormal
    local_reg)) = do
      let Reg64 Reg
    hi Reg
    lo = HasDebugCallStack => CmmFormal -> Reg64
    CmmFormal -> Reg64
    localReg64 CmmFormal
    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)

    iselExpr64 (CmmLit (CmmInt Integer
    i Width
    _)) = do
      Reg64 rhi rlo <- NatM Reg64
    getNewReg64
      let
            half0 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    i :: Word16)
            half1 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer
    i Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16) :: Word16)
            half2 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer
    i Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    32) :: Word16)
            half3 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer
    i Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    48) :: Word16)

            code = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                    Reg -> Imm -> Instr
    LIS Reg
    rlo (Int -> Imm
    ImmInt Int
    half1),
                    Reg -> Reg -> RI -> Instr
    OR Reg
    rlo Reg
    rlo (Imm -> RI
    RIImm (Imm -> RI) -> Imm -> RI
    forall a b. (a -> b) -> a -> b
    $ Int -> Imm
    ImmInt Int
    half0),
                    Reg -> Imm -> Instr
    LIS Reg
    rhi (Int -> Imm
    ImmInt Int
    half3),
                    Reg -> Reg -> RI -> Instr
    OR Reg
    rhi Reg
    rhi (Imm -> RI
    RIImm (Imm -> RI) -> Imm -> RI
    forall a b. (a -> b) -> a -> b
    $ Int -> Imm
    ImmInt Int
    half2)
                    ]
      return (RegCode64 code rhi rlo)

    iselExpr64 (CmmMachOp (MO_Add Width
    _) [CmmExpr
    e1,CmmExpr
    e2]) = do
       RegCode64 code1 r1hi r1lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    e1
       RegCode64 code2 r2hi r2lo <- iselExpr64 e2
       Reg64 rhi rlo <- getNewReg64
       let
            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 [ Reg -> Reg -> Reg -> Instr
    ADDC Reg
    rlo Reg
    r1lo Reg
    r2lo,
                           Reg -> Reg -> Reg -> Instr
    ADDE Reg
    rhi Reg
    r1hi Reg
    r2hi ]
       return (RegCode64 code rhi rlo)

    iselExpr64 (CmmMachOp (MO_Sub Width
    _) [CmmExpr
    e1,CmmExpr
    e2]) = do
       RegCode64 code1 r1hi r1lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    e1
       RegCode64 code2 r2hi r2lo <- iselExpr64 e2
       Reg64 rhi rlo <- getNewReg64
       let
            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 [ Reg -> Reg -> RI -> Instr
    SUBFC Reg
    rlo Reg
    r2lo (Reg -> RI
    RIReg Reg
    r1lo),
                           Reg -> Reg -> Reg -> Instr
    SUBFE Reg
    rhi Reg
    r2hi Reg
    r1hi ]
       return (RegCode64 code rhi rlo)

    iselExpr64 (CmmMachOp (MO_UU_Conv Width
    W32 Width
    W64) [CmmExpr
    expr]) = do
        (expr_reg,expr_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    expr
        Reg64 rhi rlo <- getNewReg64
        let mov_hi = Reg -> Imm -> Instr
    LI Reg
    rhi (Int -> Imm
    ImmInt Int
    0)
            mov_lo = Reg -> Reg -> Instr
    MR Reg
    rlo Reg
    expr_reg
        return $ RegCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)
                           rhi rlo

    iselExpr64 (CmmMachOp (MO_SS_Conv Width
    W32 Width
    W64) [CmmExpr
    expr]) = do
        (expr_reg,expr_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    expr
        Reg64 rhi rlo <- getNewReg64
        let mov_hi = Format -> Reg -> Reg -> RI -> Instr
    SRA Format
    II32 Reg
    rhi Reg
    expr_reg (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    31))
            mov_lo = Reg -> Reg -> Instr
    MR Reg
    rlo Reg
    expr_reg
        return $ RegCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)
                           rhi rlo
    iselExpr64 CmmExpr
    expr
       = do
         platform <- NatM Platform
    getPlatform
         pprPanic "iselExpr64(powerpc)" (pdoc platform expr)

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

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

    getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    _ Platform
    platform (CmmReg (CmmGlobal (GlobalRegUse GlobalReg
    PicBaseReg CmmType
    _)))
      | OS
    OSAIX <- Platform -> OS
    platformOS Platform
    platform = do
            let code :: Reg -> OrdList Instr
    code Reg
    dst = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Format -> Reg -> AddrMode -> Instr
    LD Format
    II32 Reg
    dst AddrMode
    tocAddr ]
                tocAddr :: AddrMode
    tocAddr = Reg -> Imm -> AddrMode
    AddrRegImm Reg
    toc (FastString -> Imm
    ImmLit (String -> FastString
    fsLit String
    "ghc_toc_table[TC]"))
            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)
      | Platform -> Bool
    target32Bit Platform
    platform = do
          reg <- Format -> NatM Reg
    getPicBaseNat (Format -> NatM Reg) -> Format -> NatM Reg
    forall a b. (a -> b) -> a -> b
    $ Bool -> Format
    archWordFormat (Platform -> Bool
    target32Bit Platform
    platform)
          return (Fixed (archWordFormat (target32Bit platform))
                        reg nilOL)
      | Bool
    otherwise = Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> Reg -> OrdList Instr -> Register
    Fixed Format
    II64 Reg
    toc OrdList Instr
    forall a. OrdList a
    nilOL)

    getRegister' NCGConfig
    _ Platform
    platform (CmmReg CmmReg
    reg)
      = Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> Reg -> OrdList Instr -> Register
    Fixed (CmmType -> Format
    cmmTypeFormat (CmmReg -> CmmType
    cmmRegType CmmReg
    reg))
                      (Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform CmmReg
    reg) OrdList Instr
    forall a. OrdList a
    nilOL)

    getRegister' NCGConfig
    config Platform
    platform tree :: CmmExpr
    tree@(CmmRegOff CmmReg
    _ Int
    _)
      = NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    platform (CmmExpr -> CmmExpr
    mangleIndexTree CmmExpr
    tree)

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

    getRegister' NCGConfig
    _ Platform
    platform (CmmMachOp (MO_UU_Conv Width
    W64 Width
    W32)
                         [CmmMachOp (MO_U_Shr Width
    W64) [CmmExpr
    x,CmmLit (CmmInt Integer
    32 Width
    _)]])
     | Platform -> Bool
    target32Bit Platform
    platform = do
      RegCode64 code _rhi rlo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
      return $ Fixed II32 (getHiVRegFromLo rlo) code

    getRegister' NCGConfig
    _ Platform
    platform (CmmMachOp (MO_SS_Conv Width
    W64 Width
    W32)
                         [CmmMachOp (MO_U_Shr Width
    W64) [CmmExpr
    x,CmmLit (CmmInt Integer
    32 Width
    _)]])
     | Platform -> Bool
    target32Bit Platform
    platform = do
      RegCode64 code _rhi rlo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
      return $ Fixed II32 (getHiVRegFromLo rlo) code

    getRegister' NCGConfig
    _ Platform
    platform (CmmMachOp (MO_UU_Conv Width
    W64 Width
    W32) [CmmExpr
    x])
     | Platform -> Bool
    target32Bit Platform
    platform = do
      RegCode64 code _rhi rlo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
      return $ Fixed II32 rlo code

    getRegister' NCGConfig
    _ Platform
    platform (CmmMachOp (MO_SS_Conv Width
    W64 Width
    W32) [CmmExpr
    x])
     | Platform -> Bool
    target32Bit Platform
    platform = do
      RegCode64 code _rhi rlo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
      return $ Fixed II32 rlo code

    getRegister' NCGConfig
    _ Platform
    platform (CmmLoad CmmExpr
    mem CmmType
    pk AlignmentSpec
    _)
     | Bool -> Bool
    not (CmmType -> Bool
    isWord64 CmmType
    pk) = do
            Amode addr addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
            let code Reg
    dst = Bool -> OrdList Instr -> OrdList Instr
    forall a. HasCallStack => Bool -> a -> a
    assert ((Platform -> Reg -> RegClass
    targetClassOfReg Platform
    platform Reg
    dst RegClass -> RegClass -> Bool
    forall a. Eq a => a -> a -> Bool
    == RegClass
    RcDouble) Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == CmmType -> Bool
    isFloatType CmmType
    pk) (OrdList Instr -> OrdList Instr) -> OrdList Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $
                           OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    format Reg
    dst AddrMode
    addr
            return (Any format code)
     | Bool -> Bool
    not (Platform -> Bool
    target32Bit Platform
    platform) = do
            Amode addr addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    DS CmmExpr
    mem
            let code Reg
    dst = OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II64 Reg
    dst AddrMode
    addr
            return (Any II64 code)

              where format :: Format
    format = CmmType -> Format
    cmmTypeFormat CmmType
    pk

    -- catch simple cases of zero- or sign-extended load
    getRegister' NCGConfig
    _ Platform
    _ (CmmMachOp (MO_UU_Conv Width
    W8 Width
    W32) [CmmLoad CmmExpr
    mem CmmType
    _ AlignmentSpec
    _]) = do
        Amode addr addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        return (Any II32 (\Reg
    dst -> OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II8 Reg
    dst AddrMode
    addr))

    getRegister' NCGConfig
    _ Platform
    _ (CmmMachOp (MO_XX_Conv Width
    W8 Width
    W32) [CmmLoad CmmExpr
    mem CmmType
    _ AlignmentSpec
    _]) = do
        Amode addr addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        return (Any II32 (\Reg
    dst -> OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II8 Reg
    dst AddrMode
    addr))

    getRegister' NCGConfig
    _ Platform
    _ (CmmMachOp (MO_UU_Conv Width
    W8 Width
    W64) [CmmLoad CmmExpr
    mem CmmType
    _ AlignmentSpec
    _]) = do
        Amode addr addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        return (Any II64 (\Reg
    dst -> OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II8 Reg
    dst AddrMode
    addr))

    getRegister' NCGConfig
    _ Platform
    _ (CmmMachOp (MO_XX_Conv Width
    W8 Width
    W64) [CmmLoad CmmExpr
    mem CmmType
    _ AlignmentSpec
    _]) = do
        Amode addr addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        return (Any II64 (\Reg
    dst -> OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II8 Reg
    dst AddrMode
    addr))

    -- Note: there is no Load Byte Arithmetic instruction, so no signed case here

    getRegister' NCGConfig
    _ Platform
    _ (CmmMachOp (MO_UU_Conv Width
    W16 Width
    W32) [CmmLoad CmmExpr
    mem CmmType
    _ AlignmentSpec
    _]) = do
        Amode addr addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        return (Any II32 (\Reg
    dst -> OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II16 Reg
    dst AddrMode
    addr))

    getRegister' NCGConfig
    _ Platform
    _ (CmmMachOp (MO_SS_Conv Width
    W16 Width
    W32) [CmmLoad CmmExpr
    mem CmmType
    _ AlignmentSpec
    _]) = do
        Amode addr addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        return (Any II32 (\Reg
    dst -> OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LA Format
    II16 Reg
    dst AddrMode
    addr))

    getRegister' NCGConfig
    _ Platform
    _ (CmmMachOp (MO_UU_Conv Width
    W16 Width
    W64) [CmmLoad CmmExpr
    mem CmmType
    _ AlignmentSpec
    _]) = do
        Amode addr addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        return (Any II64 (\Reg
    dst -> OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II16 Reg
    dst AddrMode
    addr))

    getRegister' NCGConfig
    _ Platform
    _ (CmmMachOp (MO_SS_Conv Width
    W16 Width
    W64) [CmmLoad CmmExpr
    mem CmmType
    _ AlignmentSpec
    _]) = do
        Amode addr addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        return (Any II64 (\Reg
    dst -> OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LA Format
    II16 Reg
    dst AddrMode
    addr))

    getRegister' NCGConfig
    _ Platform
    _ (CmmMachOp (MO_UU_Conv Width
    W32 Width
    W64) [CmmLoad CmmExpr
    mem CmmType
    _ AlignmentSpec
    _]) = do
        Amode addr addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        return (Any II64 (\Reg
    dst -> OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II32 Reg
    dst AddrMode
    addr))

    getRegister' NCGConfig
    _ Platform
    _ (CmmMachOp (MO_SS_Conv Width
    W32 Width
    W64) [CmmLoad CmmExpr
    mem CmmType
    _ AlignmentSpec
    _]) = do
        -- lwa is DS-form. See Note [Power instruction format]
        Amode addr addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    DS CmmExpr
    mem
        return (Any II64 (\Reg
    dst -> OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LA Format
    II32 Reg
    dst AddrMode
    addr))

    getRegister' NCGConfig
    config Platform
    platform (CmmMachOp (MO_RelaxedRead Width
    w) [CmmExpr
    e]) =
          NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    platform (CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
    CmmLoad CmmExpr
    e (Width -> CmmType
    cmmBits Width
    w) AlignmentSpec
    NaturallyAligned)

    getRegister' NCGConfig
    config Platform
    platform (CmmMachOp MachOp
    mop [CmmExpr
    x]) -- unary MachOps
      = case MachOp
    mop of
          MO_Not Width
    rep   -> Width -> (Reg -> Reg -> Instr) -> NatM Register
    triv_ucode_int Width
    rep Reg -> Reg -> Instr
    NOT

          MO_F_Neg Width
    w   -> Width -> (Reg -> Reg -> Instr) -> NatM Register
    triv_ucode_float Width
    w Reg -> Reg -> Instr
    FNEG
          MO_S_Neg Width
    w   -> Width -> (Reg -> Reg -> Instr) -> NatM Register
    triv_ucode_int   Width
    w Reg -> Reg -> Instr
    NEG

          MO_FF_Conv Width
    W64 Width
    W32 -> Format -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register
    trivialUCode  Format
    FF32 Reg -> Reg -> Instr
    FRSP CmmExpr
    x
          MO_FF_Conv Width
    W32 Width
    W64 -> Format -> CmmExpr -> NatM Register
    conversionNop Format
    FF64 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_SS_Conv Width
    from Width
    to
            | Width
    from Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Width
    to -> Format -> CmmExpr -> NatM Register
    conversionNop (Width -> Format
    intFormat Width
    to) CmmExpr
    x
            | Bool
    otherwise  -> Width -> (Reg -> Reg -> Instr) -> NatM Register
    triv_ucode_int Width
    to (Format -> Reg -> Reg -> Instr
    EXTS (Width -> Format
    intFormat Width
    from))

          MO_UU_Conv Width
    from Width
    to
            | Width
    from Width -> Width -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Width
    to -> Format -> CmmExpr -> NatM Register
    conversionNop (Width -> Format
    intFormat Width
    to) CmmExpr
    x
            | Bool
    otherwise  -> Width -> Width -> NatM Register
    clearLeft Width
    from Width
    to

          MO_XX_Conv Width
    _ Width
    to -> Format -> CmmExpr -> NatM Register
    conversionNop (Width -> Format
    intFormat Width
    to) CmmExpr
    x

          MachOp
    _ -> String -> NatM Register
    forall a. HasCallStack => String -> a
    panic String
    "PPC.CodeGen.getRegister: no match"

        where
            triv_ucode_int :: Width -> (Reg -> Reg -> Instr) -> NatM Register
    triv_ucode_int   Width
    width Reg -> Reg -> Instr
    instr = Format -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register
    trivialUCode (Width -> Format
    intFormat    Width
    width) Reg -> Reg -> Instr
    instr CmmExpr
    x
            triv_ucode_float :: Width -> (Reg -> Reg -> Instr) -> NatM Register
    triv_ucode_float Width
    width Reg -> Reg -> Instr
    instr = Format -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register
    trivialUCode (Width -> Format
    floatFormat  Width
    width) Reg -> Reg -> Instr
    instr CmmExpr
    x

            conversionNop :: Format -> CmmExpr -> NatM Register
    conversionNop Format
    new_format CmmExpr
    expr
                = do e_code <- NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    platform CmmExpr
    expr
                     return (swizzleRegisterRep e_code new_format)

            clearLeft :: Width -> Width -> NatM Register
    clearLeft Width
    from Width
    to
                = do (src1, code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
                     let arch_fmt  = Width -> Format
    intFormat (Platform -> Width
    wordWidth Platform
    platform)
                         arch_bits = Width -> Int
    widthInBits (Platform -> Width
    wordWidth Platform
    platform)
                         size      = Width -> Int
    widthInBits Width
    from
                         code Reg
    dst  = OrdList Instr
    code1 OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                     Format -> Reg -> Reg -> Int -> Instr
    CLRLI Format
    arch_fmt Reg
    dst Reg
    src1 (Int
    arch_bits Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    size)
                     return (Any (intFormat to) code)

    getRegister' NCGConfig
    _ Platform
    platform (CmmMachOp MachOp
    mop [CmmExpr
    x, CmmExpr
    y]) -- dyadic PrimOps
      = case MachOp
    mop of
          MO_F_Eq Width
    _ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg Cond
    EQQ CmmExpr
    x CmmExpr
    y
          MO_F_Ne Width
    _ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg Cond
    NE  CmmExpr
    x CmmExpr
    y
          MO_F_Gt Width
    _ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg Cond
    GTT CmmExpr
    x CmmExpr
    y
          MO_F_Ge Width
    _ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg Cond
    GE  CmmExpr
    x CmmExpr
    y
          MO_F_Lt Width
    _ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg Cond
    LTT CmmExpr
    x CmmExpr
    y
          MO_F_Le Width
    _ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg Cond
    LE  CmmExpr
    x CmmExpr
    y

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

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

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

          MO_F_Add Width
    w  -> Width -> (Format -> Reg -> Reg -> Reg -> Instr) -> NatM Register
    triv_float Width
    w Format -> Reg -> Reg -> Reg -> Instr
    FADD
          MO_F_Sub Width
    w  -> Width -> (Format -> Reg -> Reg -> Reg -> Instr) -> NatM Register
    triv_float Width
    w Format -> Reg -> Reg -> Reg -> Instr
    FSUB
          MO_F_Mul Width
    w  -> Width -> (Format -> Reg -> Reg -> Reg -> Instr) -> NatM Register
    triv_float Width
    w Format -> Reg -> Reg -> Reg -> Instr
    FMUL
          MO_F_Quot Width
    w -> Width -> (Format -> Reg -> Reg -> Reg -> Instr) -> NatM Register
    triv_float Width
    w Format -> Reg -> Reg -> Reg -> Instr
    FDIV

             -- optimize addition with 32-bit immediate
             -- (needed for PIC)
          MO_Add Width
    W32 ->
            case CmmExpr
    y of
              CmmLit (CmmInt Integer
    imm Width
    immrep) | Just Imm
    _ <- Width -> Bool -> Integer -> Maybe Imm
    forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    W32 Bool
    True Integer
    imm
                -> Width
    -> Bool
    -> (Reg -> Reg -> RI -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    W32 Bool
    True Reg -> Reg -> RI -> Instr
    ADD CmmExpr
    x (CmmLit -> CmmExpr
    CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $ Integer -> Width -> CmmLit
    CmmInt Integer
    imm Width
    immrep)
              CmmLit CmmLit
    lit
                -> do
                    (src, srcCode) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
                    let imm = CmmLit -> Imm
    litToImm CmmLit
    lit
                        code Reg
    dst = OrdList Instr
    srcCode OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                                        Reg -> Reg -> Imm -> Instr
    ADDIS Reg
    dst Reg
    src (Imm -> Imm
    HA Imm
    imm),
                                        Reg -> Reg -> RI -> Instr
    ADD Reg
    dst Reg
    dst (Imm -> RI
    RIImm (Imm -> Imm
    LO Imm
    imm))
                                    ]
                    return (Any II32 code)
              CmmExpr
    _ -> Width
    -> Bool
    -> (Reg -> Reg -> RI -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    W32 Bool
    True Reg -> Reg -> RI -> Instr
    ADD CmmExpr
    x CmmExpr
    y

          MO_Add Width
    rep -> Width
    -> Bool
    -> (Reg -> Reg -> RI -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    rep Bool
    True Reg -> Reg -> RI -> Instr
    ADD CmmExpr
    x CmmExpr
    y
          MO_Sub Width
    rep ->
            case CmmExpr
    y of
              CmmLit (CmmInt Integer
    imm Width
    immrep) | Just Imm
    _ <- Width -> Bool -> Integer -> Maybe Imm
    forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    rep Bool
    True (-Integer
    imm)
                -> Width
    -> Bool
    -> (Reg -> Reg -> RI -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    rep Bool
    True Reg -> Reg -> RI -> Instr
    ADD CmmExpr
    x (CmmLit -> CmmExpr
    CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $ Integer -> Width -> CmmLit
    CmmInt (-Integer
    imm) Width
    immrep)
              CmmExpr
    _ -> case CmmExpr
    x of
                     CmmLit (CmmInt Integer
    imm Width
    _)
                       | Just Imm
    _ <- Width -> Bool -> Integer -> Maybe Imm
    forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    rep Bool
    True Integer
    imm
                       -- subfi ('subtract from' with immediate) doesn't exist
                       -> Width
    -> Bool
    -> (Reg -> Reg -> RI -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    rep Bool
    True Reg -> Reg -> RI -> Instr
    SUBFC CmmExpr
    y CmmExpr
    x
                     CmmExpr
    _ -> Format
    -> (Reg -> Reg -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCodeNoImm' (Width -> Format
    intFormat Width
    rep) Reg -> Reg -> Reg -> Instr
    SUBF CmmExpr
    y CmmExpr
    x

          MO_Mul Width
    rep -> Width
    -> Bool
    -> (Format -> Reg -> Reg -> RI -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    shiftMulCode Width
    rep Bool
    True Format -> Reg -> Reg -> RI -> Instr
    MULL CmmExpr
    x CmmExpr
    y
          MO_S_MulMayOflo Width
    rep -> do
            (src1, code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
            (src2, code2) <- getSomeReg y
            let
              format = Width -> Format
    intFormat Width
    rep
              code Reg
    dst = 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 -> Reg -> Reg -> Reg -> Instr
    MULLO Format
    format Reg
    dst Reg
    src1 Reg
    src2
                                        , Format -> Reg -> Instr
    MFOV  Format
    format Reg
    dst
                                        ]
            return (Any format code)

          MO_S_Quot Width
    rep -> Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    divCode Width
    rep Bool
    True CmmExpr
    x CmmExpr
    y
          MO_U_Quot Width
    rep -> Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    divCode Width
    rep Bool
    False CmmExpr
    x CmmExpr
    y

          MO_S_Rem Width
    rep -> Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    remainder Width
    rep Bool
    True CmmExpr
    x CmmExpr
    y
          MO_U_Rem Width
    rep -> Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    remainder Width
    rep Bool
    False CmmExpr
    x CmmExpr
    y

          MO_And Width
    rep   -> case CmmExpr
    y of
            (CmmLit (CmmInt Integer
    imm Width
    _)) | Integer
    imm Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == -Integer
    8 Bool -> Bool -> Bool
    || Integer
    imm Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == -Integer
    4
                -> do
                    (src, srcCode) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
                    let clear_mask = if Integer
    imm Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == -Integer
    4 then Int
    2 else Int
    3
                        fmt = Width -> Format
    intFormat Width
    rep
                        arch_fmt = Width -> Format
    intFormat (Platform -> Width
    wordWidth Platform
    platform)
                        code Reg
    dst = OrdList Instr
    srcCode
                          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 -> Reg -> Int -> Instr
    CLRRI Format
    arch_fmt Reg
    dst Reg
    src Int
    clear_mask)
                    return (Any fmt code)
            CmmExpr
    _ -> Width
    -> Bool
    -> (Reg -> Reg -> RI -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    rep Bool
    False Reg -> Reg -> RI -> Instr
    AND CmmExpr
    x CmmExpr
    y
          MO_Or Width
    rep    -> Width
    -> Bool
    -> (Reg -> Reg -> RI -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    rep Bool
    False Reg -> Reg -> RI -> Instr
    OR CmmExpr
    x CmmExpr
    y
          MO_Xor Width
    rep   -> Width
    -> Bool
    -> (Reg -> Reg -> RI -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    rep Bool
    False Reg -> Reg -> RI -> Instr
    XOR CmmExpr
    x CmmExpr
    y

          MO_Shl Width
    rep   -> Width
    -> Bool
    -> (Format -> Reg -> Reg -> RI -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    shiftMulCode Width
    rep Bool
    False Format -> Reg -> Reg -> RI -> Instr
    SL CmmExpr
    x CmmExpr
    y
          MO_S_Shr Width
    rep -> Width
    -> Bool
    -> (Format -> Reg -> Reg -> RI -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    srCode Width
    rep Bool
    True Format -> Reg -> Reg -> RI -> Instr
    SRA CmmExpr
    x CmmExpr
    y
          MO_U_Shr Width
    rep -> Width
    -> Bool
    -> (Format -> Reg -> Reg -> RI -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    srCode Width
    rep Bool
    False Format -> Reg -> Reg -> RI -> Instr
    SR CmmExpr
    x CmmExpr
    y
          MachOp
    _         -> String -> NatM Register
    forall a. HasCallStack => String -> a
    panic String
    "PPC.CodeGen.getRegister: no match"

      where
        triv_float :: Width -> (Format -> Reg -> Reg -> Reg -> Instr) -> NatM Register
        triv_float :: Width -> (Format -> Reg -> Reg -> Reg -> Instr) -> NatM Register
    triv_float Width
    width Format -> Reg -> Reg -> Reg -> Instr
    instr = Format
    -> (Format -> Reg -> Reg -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCodeNoImm (Width -> Format
    floatFormat Width
    width) Format -> Reg -> Reg -> Reg -> Instr
    instr CmmExpr
    x CmmExpr
    y

        remainder :: Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
        remainder :: Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    remainder Width
    rep Bool
    sgn CmmExpr
    x CmmExpr
    y = do
          let fmt :: Format
    fmt = Width -> Format
    intFormat Width
    rep
          tmp <- Format -> NatM Reg
    getNewRegNat Format
    fmt
          code <- remainderCode rep sgn tmp x y
          return (Any fmt code)

    getRegister' NCGConfig
    _ Platform
    _ (CmmMachOp MachOp
    mop [CmmExpr
    x, CmmExpr
    y, CmmExpr
    z]) -- ternary PrimOps
      = case MachOp
    mop of

          -- x86 fmadd    x * y + z <> PPC fmadd  rt =   ra * rc + rb
          -- x86 fmsub    x * y - z <> PPC fmsub  rt =   ra * rc - rb
          -- x86 fnmadd - x * y + z ~~ PPC fnmsub rt = -(ra * rc - rb)
          -- x86 fnmsub - x * y - z ~~ PPC fnmadd rt = -(ra * rc + rb)

          MO_FMA FMASign
    variant Width
    w ->
            case FMASign
    variant of
              FMASign
    FMAdd  -> Width
    -> (Format -> Reg -> Reg -> Reg -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    fma_code Width
    w (FMASign -> Format -> Reg -> Reg -> Reg -> Reg -> Instr
    FMADD FMASign
    FMAdd) CmmExpr
    x CmmExpr
    y CmmExpr
    z
              FMASign
    FMSub  -> Width
    -> (Format -> Reg -> Reg -> Reg -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    fma_code Width
    w (FMASign -> Format -> Reg -> Reg -> Reg -> Reg -> Instr
    FMADD FMASign
    FMSub) CmmExpr
    x CmmExpr
    y CmmExpr
    z
              FMASign
    FNMAdd -> Width
    -> (Format -> Reg -> Reg -> Reg -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    fma_code Width
    w (FMASign -> Format -> Reg -> Reg -> Reg -> Reg -> Instr
    FMADD FMASign
    FNMAdd) CmmExpr
    x CmmExpr
    y CmmExpr
    z
              FMASign
    FNMSub -> Width
    -> (Format -> Reg -> Reg -> Reg -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    fma_code Width
    w (FMASign -> Format -> Reg -> Reg -> Reg -> Reg -> Instr
    FMADD FMASign
    FNMSub) CmmExpr
    x CmmExpr
    y CmmExpr
    z
          MachOp
    _ -> String -> NatM Register
    forall a. HasCallStack => String -> a
    panic String
    "PPC.CodeGen.getRegister: no match"

    getRegister' NCGConfig
    _ Platform
    _ (CmmLit (CmmInt Integer
    i Width
    rep))
      | Just Imm
    imm <- Width -> Bool -> Integer -> Maybe Imm
    forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    rep Bool
    True Integer
    i
      = let
            code :: Reg -> OrdList Instr
    code Reg
    dst = Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Reg -> Imm -> Instr
    LI Reg
    dst Imm
    imm)
        in
            Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    rep) Reg -> OrdList Instr
    code)

    getRegister' NCGConfig
    config Platform
    _ (CmmLit (CmmFloat Rational
    f Width
    frep)) = do
        lbl <- NatM CLabel
    getNewLabelNat
        dynRef <- cmmMakeDynamicReference config DataReference lbl
        Amode addr addr_code <- getAmode D dynRef
        let format = Width -> Format
    floatFormat Width
    frep
            code Reg
    dst =
                Section -> RawCmmStatics -> Instr
    LDATA (SectionType -> CLabel -> Section
    Section SectionType
    ReadOnlyData CLabel
    lbl)
                      (CLabel -> [CmmStatic] -> RawCmmStatics
    forall (rawOnly :: Bool).
    CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
    CmmStaticsRaw CLabel
    lbl [CmmLit -> CmmStatic
    CmmStaticLit (Rational -> Width -> CmmLit
    CmmFloat Rational
    f Width
    frep)])
                Instr -> OrdList Instr -> OrdList Instr
    forall a. a -> OrdList a -> OrdList a
    `consOL` (OrdList Instr
    addr_code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    format Reg
    dst AddrMode
    addr)
        return (Any format code)

    getRegister' NCGConfig
    config Platform
    platform (CmmLit CmmLit
    lit)
      | Platform -> Bool
    target32Bit Platform
    platform
      = let rep :: CmmType
    rep = 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
    toOL [
                  Reg -> Imm -> Instr
    LIS Reg
    dst (Imm -> Imm
    HA Imm
    imm),
                  Reg -> Reg -> RI -> Instr
    ADD Reg
    dst Reg
    dst (Imm -> RI
    RIImm (Imm -> Imm
    LO Imm
    imm))
              ]
        in Register -> NatM Register
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (CmmType -> Format
    cmmTypeFormat CmmType
    rep) Reg -> OrdList Instr
    code)
      | Bool
    otherwise
      = do lbl <- NatM CLabel
    getNewLabelNat
           dynRef <- cmmMakeDynamicReference config DataReference lbl
           Amode addr addr_code <- getAmode D dynRef
           let rep = Platform -> CmmLit -> CmmType
    cmmLitType Platform
    platform CmmLit
    lit
               format = CmmType -> Format
    cmmTypeFormat CmmType
    rep
               code Reg
    dst =
                Section -> RawCmmStatics -> Instr
    LDATA (SectionType -> CLabel -> Section
    Section SectionType
    ReadOnlyData CLabel
    lbl) (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 OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    format Reg
    dst AddrMode
    addr)
           return (Any format code)

    getRegister' NCGConfig
    _ Platform
    platform CmmExpr
    other = String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister(ppc)" (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    other)

        -- extend?Rep: wrap integer expression of type `from`
        -- in a conversion to `to`
    extendSExpr :: Width -> Width -> CmmExpr -> CmmExpr
    extendSExpr :: Width -> Width -> CmmExpr -> CmmExpr
    extendSExpr Width
    from Width
    to CmmExpr
    x = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> Width -> MachOp
    MO_SS_Conv Width
    from Width
    to) [CmmExpr
    x]

    extendUExpr :: Width -> Width -> CmmExpr -> CmmExpr
    extendUExpr :: Width -> Width -> CmmExpr -> CmmExpr
    extendUExpr Width
    from Width
    to CmmExpr
    x = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> Width -> MachOp
    MO_UU_Conv Width
    from Width
    to) [CmmExpr
    x]

    -- -----------------------------------------------------------------------------
    --  The 'Amode' type: 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 [Power instruction format]
       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In some instructions the 16 bit offset must be a multiple of 4, i.e.
    the two least significant bits must be zero. The "Power ISA" specification
    calls these instruction formats "DS-FORM" and the instructions with
    arbitrary 16 bit offsets are "D-FORM".

    The Power ISA specification document can be obtained from www.power.org.
    -}
    data InstrForm = D | DS

    getAmode :: InstrForm -> CmmExpr -> NatM Amode
    getAmode :: InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    inf tree :: CmmExpr
    tree@(CmmRegOff CmmReg
    _ Int
    _)
      = InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    inf (CmmExpr -> CmmExpr
    mangleIndexTree CmmExpr
    tree)

    getAmode InstrForm
    _ (CmmMachOp (MO_Sub Width
    W32) [CmmExpr
    x, CmmLit (CmmInt Integer
    i Width
    _)])
      | Just Imm
    off <- Width -> Bool -> Integer -> Maybe Imm
    forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    W32 Bool
    True (-Integer
    i)
      = do
            (reg, code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
            return (Amode (AddrRegImm reg off) code)

    getAmode InstrForm
    _ (CmmMachOp (MO_Add Width
    W32) [CmmExpr
    x, CmmLit (CmmInt Integer
    i Width
    _)])
      | Just Imm
    off <- Width -> Bool -> Integer -> Maybe Imm
    forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    W32 Bool
    True Integer
    i
      = do
            (reg, code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
            return (Amode (AddrRegImm reg off) code)

    getAmode InstrForm
    D (CmmMachOp (MO_Sub Width
    W64) [CmmExpr
    x, CmmLit (CmmInt Integer
    i Width
    _)])
      | Just Imm
    off <- Width -> Bool -> Integer -> Maybe Imm
    forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    W64 Bool
    True (-Integer
    i)
      = do
            (reg, code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
            return (Amode (AddrRegImm reg off) code)

    getAmode InstrForm
    D (CmmMachOp (MO_Add Width
    W64) [CmmExpr
    x, CmmLit (CmmInt Integer
    i Width
    _)])
      | Just Imm
    off <- Width -> Bool -> Integer -> Maybe Imm
    forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    W64 Bool
    True Integer
    i
      = do
            (reg, code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
            return (Amode (AddrRegImm reg off) code)

    getAmode InstrForm
    DS (CmmMachOp (MO_Sub Width
    W64) [CmmExpr
    x, CmmLit (CmmInt Integer
    i Width
    _)])
      | Just Imm
    off <- Width -> Bool -> Integer -> Maybe Imm
    forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    W64 Bool
    True (-Integer
    i)
      = do
            (reg, code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
            (reg', off', code')  <-
                         if i `mod` 4 == 0
                          then return (reg, off, code)
                          else do
                               tmp <- getNewRegNat II64
                               return (tmp, ImmInt 0,
                                      code `snocOL` ADD tmp reg (RIImm off))
            return (Amode (AddrRegImm reg' off') code')

    getAmode InstrForm
    DS (CmmMachOp (MO_Add Width
    W64) [CmmExpr
    x, CmmLit (CmmInt Integer
    i Width
    _)])
      | Just Imm
    off <- Width -> Bool -> Integer -> Maybe Imm
    forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    W64 Bool
    True Integer
    i
      = do
            (reg, code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
            (reg', off', code')  <-
                         if i `mod` 4 == 0
                          then return (reg, off, code)
                          else do
                               tmp <- getNewRegNat II64
                               return (tmp, ImmInt 0,
                                      code `snocOL` ADD tmp reg (RIImm off))
            return (Amode (AddrRegImm reg' off') code')

       -- optimize addition with 32-bit immediate
       -- (needed for PIC)
    getAmode InstrForm
    _ (CmmMachOp (MO_Add Width
    W32) [CmmExpr
    x, CmmLit CmmLit
    lit])
      = do
            platform <- NatM Platform
    getPlatform
            (src, srcCode) <- getSomeReg x
            let imm = CmmLit -> Imm
    litToImm CmmLit
    lit
            case () of
                ()
    _ | OS
    OSAIX <- Platform -> OS
    platformOS Platform
    platform
                  , CmmLit -> Bool
    isCmmLabelType CmmLit
    lit ->
                        -- HA16/LO16 relocations on labels not supported on AIX
                        Amode -> NatM Amode
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode -> OrdList Instr -> Amode
    Amode (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    src Imm
    imm) OrdList Instr
    srcCode)
                  | Bool
    otherwise -> do
                        tmp <- Format -> NatM Reg
    getNewRegNat Format
    II32
                        let code = OrdList Instr
    srcCode OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Imm -> Instr
    ADDIS Reg
    tmp Reg
    src (Imm -> Imm
    HA Imm
    imm)
                        return (Amode (AddrRegImm tmp (LO imm)) code)
      where
          isCmmLabelType :: CmmLit -> Bool
    isCmmLabelType (CmmLabel {})        = Bool
    True
          isCmmLabelType (CmmLabelOff {})     = Bool
    True
          isCmmLabelType (CmmLabelDiffOff {}) = Bool
    True
          isCmmLabelType CmmLit
    _                    = Bool
    False

    getAmode InstrForm
    _ (CmmLit CmmLit
    lit)
      = do
            platform <- NatM Platform
    getPlatform
            case platformArch platform of
                 Arch
    ArchPPC -> do
                     tmp <- Format -> NatM Reg
    getNewRegNat Format
    II32
                     let imm = CmmLit -> Imm
    litToImm CmmLit
    lit
                         code = Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Reg -> Imm -> Instr
    LIS Reg
    tmp (Imm -> Imm
    HA Imm
    imm))
                     return (Amode (AddrRegImm tmp (LO imm)) code)
                 Arch
    _        -> do -- TODO: Load from TOC,
                                -- see getRegister' _ (CmmLit lit)
                     tmp <- Format -> NatM Reg
    getNewRegNat Format
    II64
                     let imm = CmmLit -> Imm
    litToImm CmmLit
    lit
                         code =  [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                              Reg -> Imm -> Instr
    LIS Reg
    tmp (Imm -> Imm
    HIGHESTA Imm
    imm),
                              Reg -> Reg -> RI -> Instr
    OR Reg
    tmp Reg
    tmp (Imm -> RI
    RIImm (Imm -> Imm
    HIGHERA Imm
    imm)),
                              Format -> Reg -> Reg -> RI -> Instr
    SL  Format
    II64 Reg
    tmp Reg
    tmp (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    32)),
                              Reg -> Reg -> Imm -> Instr
    ORIS Reg
    tmp Reg
    tmp (Imm -> Imm
    HA Imm
    imm)
                              ]
                     return (Amode (AddrRegImm tmp (LO imm)) code)

    getAmode InstrForm
    _ (CmmMachOp (MO_Add Width
    W32) [CmmExpr
    x, CmmExpr
    y])
      = do
            (regX, codeX) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
            (regY, codeY) <- getSomeReg y
            return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))

    getAmode InstrForm
    _ (CmmMachOp (MO_Add Width
    W64) [CmmExpr
    x, CmmExpr
    y])
      = do
            (regX, codeX) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
            (regY, codeY) <- getSomeReg y
            return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))

    getAmode InstrForm
    _ CmmExpr
    other
      = do
            (reg, code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    other
            let
                off  = Int -> Imm
    ImmInt Int
    0
            return (Amode (AddrRegImm reg off) code)

    --  The 'CondCode' type:  Condition codes passed up the tree.
    data CondCode
            = CondCode Bool Cond InstrBlock

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

    getCondCode :: CmmExpr -> NatM CondCode

    -- almost the same as everywhere else - but we need to
    -- extend small integers to 32 bit or 64 bit first

    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
          MO_F_Lt Width
    W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    LTT CmmExpr
    x CmmExpr
    y
          MO_F_Le Width
    W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    LE  CmmExpr
    x CmmExpr
    y

          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
    LTT CmmExpr
    x CmmExpr
    y
          MO_F_Le Width
    W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    LE  CmmExpr
    x CmmExpr
    y

          MO_Eq Width
    rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode Cond
    EQQ Width
    rep CmmExpr
    x CmmExpr
    y
          MO_Ne Width
    rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode Cond
    NE  Width
    rep CmmExpr
    x CmmExpr
    y

          MO_S_Gt Width
    rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode Cond
    GTT Width
    rep CmmExpr
    x CmmExpr
    y
          MO_S_Ge Width
    rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode Cond
    GE  Width
    rep CmmExpr
    x CmmExpr
    y
          MO_S_Lt Width
    rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode Cond
    LTT Width
    rep CmmExpr
    x CmmExpr
    y
          MO_S_Le Width
    rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode Cond
    LE  Width
    rep CmmExpr
    x CmmExpr
    y

          MO_U_Gt Width
    rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode Cond
    GU  Width
    rep CmmExpr
    x CmmExpr
    y
          MO_U_Ge Width
    rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode Cond
    GEU Width
    rep CmmExpr
    x CmmExpr
    y
          MO_U_Lt Width
    rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode Cond
    LU  Width
    rep CmmExpr
    x CmmExpr
    y
          MO_U_Le Width
    rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode Cond
    LEU Width
    rep CmmExpr
    x CmmExpr
    y

          MachOp
    _ -> String -> SDoc -> NatM CondCode
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getCondCode(powerpc)" (MachOp -> SDoc
    pprMachOp MachOp
    mop)

    getCondCode CmmExpr
    _ = String -> NatM CondCode
    forall a. HasCallStack => String -> a
    panic String
    "getCondCode(2)(powerpc)"

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

    condIntCode :: Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode :: Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode Cond
    cond Width
    width CmmExpr
    x CmmExpr
    y = do
      platform <- NatM Platform
    getPlatform
      condIntCode' (target32Bit platform) cond width x y

    condIntCode' :: Bool -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode

    -- simple code for 64-bit on 32-bit platforms
    condIntCode' :: Bool -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode' Bool
    True Cond
    cond Width
    W64 CmmExpr
    x CmmExpr
    y
      | Cond -> Bool
    condUnsigned Cond
    cond
      = do
          RegCode64 code_x x_hi x_lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
          RegCode64 code_y y_hi y_lo <- iselExpr64 y
          end_lbl <- getBlockIdNat
          let code = OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                     [ Format -> Reg -> RI -> Instr
    CMPL Format
    II32 Reg
    x_hi (Reg -> RI
    RIReg Reg
    y_hi)
                     , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    NE BlockId
    end_lbl Maybe Bool
    forall a. Maybe a
    Nothing
                     , Format -> Reg -> RI -> Instr
    CMPL Format
    II32 Reg
    x_lo (Reg -> RI
    RIReg Reg
    y_lo)
                     , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    end_lbl Maybe Bool
    forall a. Maybe a
    Nothing

                     , BlockId -> Instr
    NEWBLOCK BlockId
    end_lbl
                     ]
          return (CondCode False cond code)
      | Bool
    otherwise
      = do
          RegCode64 code_x x_hi x_lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    x
          RegCode64 code_y y_hi y_lo <- iselExpr64 y
          end_lbl <- getBlockIdNat
          cmp_lo  <- getBlockIdNat
          let code = OrdList Instr
    code_x OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                     [ Format -> Reg -> RI -> Instr
    CMP Format
    II32 Reg
    x_hi (Reg -> RI
    RIReg Reg
    y_hi)
                     , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    NE BlockId
    end_lbl Maybe Bool
    forall a. Maybe a
    Nothing
                     , Format -> Reg -> RI -> Instr
    CMP Format
    II32 Reg
    x_hi (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    0))
                     , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    LE BlockId
    cmp_lo Maybe Bool
    forall a. Maybe a
    Nothing
                     , Format -> Reg -> RI -> Instr
    CMPL Format
    II32 Reg
    x_lo (Reg -> RI
    RIReg Reg
    y_lo)
                     , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    end_lbl Maybe Bool
    forall a. Maybe a
    Nothing
                     , BlockId -> Instr
    NEWBLOCK BlockId
    cmp_lo
                     , Format -> Reg -> RI -> Instr
    CMPL Format
    II32 Reg
    y_lo (Reg -> RI
    RIReg Reg
    x_lo)
                     , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    end_lbl Maybe Bool
    forall a. Maybe a
    Nothing

                     , BlockId -> Instr
    NEWBLOCK BlockId
    end_lbl
                     ]
          return (CondCode False cond code)

    -- optimize pointer tag checks. Operation andi. sets condition register
    -- so cmpi ..., 0 is redundant.
    condIntCode' Bool
    _ Cond
    cond Width
    _ (CmmMachOp (MO_And Width
    _) [CmmExpr
    x, CmmLit (CmmInt Integer
    imm Width
    rep)])
                     (CmmLit (CmmInt Integer
    0 Width
    _))
      | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Cond -> Bool
    condUnsigned Cond
    cond,
        Just Imm
    src2 <- Width -> Bool -> Integer -> Maybe Imm
    forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    rep Bool
    False Integer
    imm
      = do
          (src1, code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
          let code' = OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> RI -> Instr
    AND Reg
    r0 Reg
    src1 (Imm -> RI
    RIImm Imm
    src2)
          return (CondCode False cond code')

    condIntCode' Bool
    _ Cond
    cond Width
    width CmmExpr
    x (CmmLit (CmmInt Integer
    y Width
    rep))
      | Just Imm
    src2 <- Width -> Bool -> Integer -> Maybe Imm
    forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    rep (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Cond -> Bool
    condUnsigned Cond
    cond) Integer
    y
      = do
          let op_len :: Width
    op_len = Width -> Width -> Width
    forall a. Ord a => a -> a -> a
    max Width
    W32 Width
    width
          let extend :: CmmExpr -> CmmExpr
    extend = if Cond -> Bool
    condUnsigned Cond
    cond then Width -> Width -> CmmExpr -> CmmExpr
    extendUExpr Width
    width Width
    op_len
                       else Width -> Width -> CmmExpr -> CmmExpr
    extendSExpr Width
    width Width
    op_len
          (src1, code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (CmmExpr -> CmmExpr
    extend CmmExpr
    x)
          let format = Width -> Format
    intFormat Width
    op_len
              code' = OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                (if Cond -> Bool
    condUnsigned Cond
    cond then Format -> Reg -> RI -> Instr
    CMPL else Format -> Reg -> RI -> Instr
    CMP) Format
    format Reg
    src1 (Imm -> RI
    RIImm Imm
    src2)
          return (CondCode False cond code')

    condIntCode' Bool
    _ Cond
    cond Width
    width CmmExpr
    x CmmExpr
    y = do
      let op_len :: Width
    op_len = Width -> Width -> Width
    forall a. Ord a => a -> a -> a
    max Width
    W32 Width
    width
      let extend :: CmmExpr -> CmmExpr
    extend = if Cond -> Bool
    condUnsigned Cond
    cond then Width -> Width -> CmmExpr -> CmmExpr
    extendUExpr Width
    width Width
    op_len
                   else Width -> Width -> CmmExpr -> CmmExpr
    extendSExpr Width
    width Width
    op_len
      (src1, code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (CmmExpr -> CmmExpr
    extend CmmExpr
    x)
      (src2, code2) <- getSomeReg (extend y)
      let format = Width -> Format
    intFormat Width
    op_len
          code' = OrdList Instr
    code1 OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code2 OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
            (if Cond -> Bool
    condUnsigned Cond
    cond then Format -> Reg -> RI -> Instr
    CMPL else Format -> Reg -> RI -> Instr
    CMP) Format
    format Reg
    src1 (Reg -> RI
    RIReg Reg
    src2)
      return (CondCode False cond code')

    condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    cond CmmExpr
    x CmmExpr
    y = do
        (src1, code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
        (src2, code2) <- getSomeReg y
        let
            code'  = OrdList Instr
    code1 OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code2 OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Instr
    FCMP Reg
    src1 Reg
    src2
            code'' = case Cond
    cond of -- twiddle CR to handle unordered case
                        Cond
    GE -> OrdList Instr
    code' OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Int -> Int -> Int -> Instr
    CRNOR Int
    ltbit Int
    eqbit Int
    gtbit
                        Cond
    LE -> OrdList Instr
    code' OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Int -> Int -> Int -> Instr
    CRNOR Int
    gtbit Int
    eqbit Int
    ltbit
                        Cond
    _ -> OrdList Instr
    code'
                     where
                        ltbit :: Int
    ltbit = Int
    0 ; eqbit :: Int
    eqbit = Int
    2 ; gtbit :: Int
    gtbit = Int
    1
        return (CondCode True cond code'')

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

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

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

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

    assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_IntCode Format
    pk CmmExpr
    addr CmmExpr
    src = do
        (srcReg, code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    src
        Amode dstAddr addr_code <- case pk of
                                    Format
    II64 -> InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    DS CmmExpr
    addr
                                    Format
    _    -> InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D  CmmExpr
    addr
        return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr

    -- dst is a reg, but src could be anything
    assignReg_IntCode :: Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_IntCode Format
    _ CmmReg
    reg CmmExpr
    src
        = do
            platform <- NatM Platform
    getPlatform
            let dst = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform CmmReg
    reg
            r <- getRegister src
            return $ case r of
                Any Format
    _ Reg -> OrdList Instr
    code         -> Reg -> OrdList Instr
    code Reg
    dst
                Fixed Format
    _ Reg
    freg OrdList Instr
    fcode -> OrdList Instr
    fcode OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Instr
    MR Reg
    dst Reg
    freg

    -- Easy, isn't it?
    assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_FltCode = Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_IntCode
    assignReg_FltCode :: Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_FltCode = Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_IntCode

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

    genJump :: CmmExpr -> [Reg] -> NatM (OrdList Instr)
    genJump (CmmLit (CmmLabel CLabel
    lbl)) [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 (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ CLabel -> [Reg] -> Instr
    JMP CLabel
    lbl [Reg]
    regs)

    genJump CmmExpr
    tree [Reg]
    gregs
      = do
            platform <- NatM Platform
    getPlatform
            genJump' tree (platformToGCP platform) gregs

    genJump' :: CmmExpr -> GenCCallPlatform -> [Reg] -> NatM InstrBlock

    genJump' :: CmmExpr -> GenCCallPlatform -> [Reg] -> NatM (OrdList Instr)
    genJump' CmmExpr
    tree (GCP64ELF Int
    1) [Reg]
    regs
      = do
            (target,code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    tree
            return (code
                   `snocOL` LD II64 r11 (AddrRegImm target (ImmInt 0))
                   `snocOL` LD II64 toc (AddrRegImm target (ImmInt 8))
                   `snocOL` MTCTR r11
                   `snocOL` LD II64 r11 (AddrRegImm target (ImmInt 16))
                   `snocOL` BCTR [] Nothing regs)

    genJump' CmmExpr
    tree (GCP64ELF Int
    2) [Reg]
    regs
      = do
            (target,code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    tree
            return (code
                   `snocOL` MR r12 target
                   `snocOL` MTCTR r12
                   `snocOL` BCTR [] Nothing regs)

    genJump' CmmExpr
    tree GenCCallPlatform
    _ [Reg]
    regs
      = do
            (target,code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    tree
            return (code `snocOL` MTCTR target `snocOL` BCTR [] Nothing regs)

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

    -- -----------------------------------------------------------------------------
    --  Conditional jumps

    {-
    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.
    -}

    genCondJump
        :: BlockId      -- the branch target
        -> CmmExpr      -- the condition on which to branch
        -> Maybe Bool
        -> NatM InstrBlock

    genCondJump :: BlockId -> CmmExpr -> Maybe Bool -> NatM (OrdList Instr)
    genCondJump BlockId
    id CmmExpr
    bool Maybe Bool
    prediction = do
      CondCode _ cond code <- CmmExpr -> NatM CondCode
    getCondCode CmmExpr
    bool
      return (code `snocOL` BCC cond id prediction)

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

    genCCall :: ForeignTarget      -- function to call
             -> [CmmFormal]        -- where to put the result
             -> [CmmActual]        -- arguments (of mixed type)
             -> NatM InstrBlock
    genCCall :: ForeignTarget -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    genCCall (PrimTarget CallishMachOp
    MO_AcquireFence) [CmmFormal]
    _ [CmmExpr]
    _
     = 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
    LWSYNC
    genCCall (PrimTarget CallishMachOp
    MO_ReleaseFence) [CmmFormal]
    _ [CmmExpr]
    _
     = 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
    LWSYNC
    genCCall (PrimTarget CallishMachOp
    MO_SeqCstFence) [CmmFormal]
    _ [CmmExpr]
    _
     = 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
    HWSYNC

    genCCall (PrimTarget CallishMachOp
    MO_Touch) [CmmFormal]
    _ [CmmExpr]
    _
     = 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
    forall a. OrdList a
    nilOL

    genCCall (PrimTarget (MO_Prefetch_Data Int
    _)) [CmmFormal]
    _ [CmmExpr]
    _
     = 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
    forall a. OrdList a
    nilOL

    genCCall (PrimTarget (MO_AtomicRMW Width
    width AtomicMachOp
    amop)) [CmmFormal
    dst] [CmmExpr
    addr, CmmExpr
    n]
     = do let fmt :: Format
    fmt      = Width -> Format
    intFormat Width
    width
              reg_dst :: Reg
    reg_dst  = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    dst
          (instr, n_code) <- case AtomicMachOp
    amop of
                AtomicMachOp
    AMO_Add  -> (Reg -> Reg -> RI -> Instr)
    -> Bool -> Reg -> NatM (Instr, OrdList Instr)
    getSomeRegOrImm Reg -> Reg -> RI -> Instr
    ADD Bool
    True Reg
    reg_dst
                AtomicMachOp
    AMO_Sub  -> case CmmExpr
    n of
                    CmmLit (CmmInt Integer
    i Width
    _)
                      | Just Imm
    imm <- Width -> Bool -> Integer -> Maybe Imm
    forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    width Bool
    True (-Integer
    i)
                       -> (Instr, OrdList Instr) -> NatM (Instr, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg -> Reg -> RI -> Instr
    ADD Reg
    reg_dst Reg
    reg_dst (Imm -> RI
    RIImm Imm
    imm), OrdList Instr
    forall a. OrdList a
    nilOL)
                    CmmExpr
    _
                       -> do
                             (n_reg, n_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    n
                             return  (SUBF reg_dst n_reg reg_dst, n_code)
                AtomicMachOp
    AMO_And  -> (Reg -> Reg -> RI -> Instr)
    -> Bool -> Reg -> NatM (Instr, OrdList Instr)
    getSomeRegOrImm Reg -> Reg -> RI -> Instr
    AND Bool
    False Reg
    reg_dst
                AtomicMachOp
    AMO_Nand -> do (n_reg, n_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    n
                               return (NAND reg_dst reg_dst n_reg, n_code)
                AtomicMachOp
    AMO_Or   -> (Reg -> Reg -> RI -> Instr)
    -> Bool -> Reg -> NatM (Instr, OrdList Instr)
    getSomeRegOrImm Reg -> Reg -> RI -> Instr
    OR Bool
    False Reg
    reg_dst
                AtomicMachOp
    AMO_Xor  -> (Reg -> Reg -> RI -> Instr)
    -> Bool -> Reg -> NatM (Instr, OrdList Instr)
    getSomeRegOrImm Reg -> Reg -> RI -> Instr
    XOR Bool
    False Reg
    reg_dst
          Amode addr_reg addr_code <- getAmodeIndex addr
          lbl_retry <- getBlockIdNat
          return $ n_code `appOL` addr_code
            `appOL` toOL [ HWSYNC
                         , BCC ALWAYS lbl_retry Nothing

                         , NEWBLOCK lbl_retry
                         , LDR fmt reg_dst addr_reg
                         , instr
                         , STC fmt reg_dst addr_reg
                         , BCC NE lbl_retry (Just False)
                         , ISYNC
                         ]
             where
               getAmodeIndex :: CmmExpr -> NatM Amode
    getAmodeIndex (CmmMachOp (MO_Add Width
    _) [CmmExpr
    x, CmmExpr
    y])
                 = do
                     (regX, codeX) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
                     (regY, codeY) <- getSomeReg y
                     return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))
               getAmodeIndex CmmExpr
    other
                 = do
                     (reg, code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    other
                     return (Amode (AddrRegReg r0 reg) code) -- NB: r0 is 0 here!
               getSomeRegOrImm :: (Reg -> Reg -> RI -> Instr)
    -> Bool -> Reg -> NatM (Instr, OrdList Instr)
    getSomeRegOrImm Reg -> Reg -> RI -> Instr
    op Bool
    sign Reg
    dst
                 = case CmmExpr
    n of
                     CmmLit (CmmInt Integer
    i Width
    _) | Just Imm
    imm <- Width -> Bool -> Integer -> Maybe Imm
    forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    width Bool
    sign Integer
    i
                        -> (Instr, OrdList Instr) -> NatM (Instr, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg -> Reg -> RI -> Instr
    op Reg
    dst Reg
    dst (Imm -> RI
    RIImm Imm
    imm), OrdList Instr
    forall a. OrdList a
    nilOL)
                     CmmExpr
    _
                        -> do
                              (n_reg, n_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    n
                              return  (op dst dst (RIReg n_reg), n_code)

    genCCall (PrimTarget (MO_AtomicRead Width
    width MemoryOrdering
    _)) [CmmFormal
    dst] [CmmExpr
    addr]
     = do let fmt :: Format
    fmt      = Width -> Format
    intFormat Width
    width
              reg_dst :: Reg
    reg_dst  = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    dst
              form :: InstrForm
    form     = if Width -> Int
    widthInBits Width
    width Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    64 then InstrForm
    DS else InstrForm
    D
          Amode addr_reg addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    form CmmExpr
    addr
          lbl_end <- getBlockIdNat
          return $ addr_code `appOL` toOL [ HWSYNC
                                          , LD fmt reg_dst addr_reg
                                          , CMP fmt reg_dst (RIReg reg_dst)
                                          , BCC NE lbl_end (Just False)
                                          , BCC ALWAYS lbl_end Nothing
                                -- See Note [Seemingly useless cmp and bne]
                                          , NEWBLOCK lbl_end
                                          , ISYNC
                                          ]

    -- Note [Seemingly useless cmp and bne]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- In Power ISA, Book II, Section 4.4.1, Instruction Synchronize Instruction
    -- the second paragraph says that isync may complete before storage accesses
    -- "associated" with a preceding instruction have been performed. The cmp
    -- operation and the following bne introduce a data and control dependency
    -- on the load instruction (See also Power ISA, Book II, Appendix B.2.3, Safe
    -- Fetch).
    -- This is also what gcc does.

    genCCall (PrimTarget (MO_AtomicWrite Width
    width MemoryOrdering
    _)) [] [CmmExpr
    addr, CmmExpr
    val] = do
        code <- Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_IntCode (Width -> Format
    intFormat Width
    width) CmmExpr
    addr CmmExpr
    val
        return $ unitOL HWSYNC `appOL` code

    genCCall (PrimTarget (MO_Cmpxchg Width
    width)) [CmmFormal
    dst] [CmmExpr
    addr, CmmExpr
    old, CmmExpr
    new]
      | Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W32 Bool -> Bool -> Bool
    || Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64
      = do
          (old_reg, old_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    old
          (new_reg, new_code) <- getSomeReg new
          (addr_reg, addr_code) <- getSomeReg addr
          lbl_retry <- getBlockIdNat
          lbl_eq    <- getBlockIdNat
          lbl_end   <- getBlockIdNat
          let reg_dst   = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    dst
              code      = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL
                          [ Instr
    HWSYNC
                          , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    lbl_retry Maybe Bool
    forall a. Maybe a
    Nothing
                          , BlockId -> Instr
    NEWBLOCK BlockId
    lbl_retry
                          , Format -> Reg -> AddrMode -> Instr
    LDR Format
    format Reg
    reg_dst (Reg -> Reg -> AddrMode
    AddrRegReg Reg
    r0 Reg
    addr_reg)
                          , Format -> Reg -> RI -> Instr
    CMP Format
    format Reg
    reg_dst (Reg -> RI
    RIReg Reg
    old_reg)
                          , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    NE BlockId
    lbl_end Maybe Bool
    forall a. Maybe a
    Nothing
                          , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    lbl_eq Maybe Bool
    forall a. Maybe a
    Nothing
                          , BlockId -> Instr
    NEWBLOCK BlockId
    lbl_eq
                          , Format -> Reg -> AddrMode -> Instr
    STC Format
    format Reg
    new_reg (Reg -> Reg -> AddrMode
    AddrRegReg Reg
    r0 Reg
    addr_reg)
                          , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    NE BlockId
    lbl_retry Maybe Bool
    forall a. Maybe a
    Nothing
                          , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    lbl_end Maybe Bool
    forall a. Maybe a
    Nothing
                          , BlockId -> Instr
    NEWBLOCK BlockId
    lbl_end
                          , Instr
    ISYNC
                          ]
          return $ addr_code `appOL` new_code `appOL` old_code `appOL` code
      where
        format :: Format
    format = Width -> Format
    intFormat Width
    width

    genCCall (PrimTarget (MO_Clz Width
    width)) [CmmFormal
    dst] [CmmExpr
    src]
     = do platform <- NatM Platform
    getPlatform
          let reg_dst = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    dst
          if target32Bit platform && width == W64
            then do
              RegCode64 code vr_hi vr_lo <- iselExpr64 src
              lbl1 <- getBlockIdNat
              lbl2 <- getBlockIdNat
              lbl3 <- getBlockIdNat
              let cntlz = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Format -> Reg -> RI -> Instr
    CMPL Format
    II32 Reg
    vr_hi (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    0))
                               , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    NE BlockId
    lbl2 Maybe Bool
    forall a. Maybe a
    Nothing
                               , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    lbl1 Maybe Bool
    forall a. Maybe a
    Nothing

                               , BlockId -> Instr
    NEWBLOCK BlockId
    lbl1
                               , Format -> Reg -> Reg -> Instr
    CNTLZ Format
    II32 Reg
    reg_dst Reg
    vr_lo
                               , Reg -> Reg -> RI -> Instr
    ADD Reg
    reg_dst Reg
    reg_dst (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    32))
                               , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    lbl3 Maybe Bool
    forall a. Maybe a
    Nothing

                               , BlockId -> Instr
    NEWBLOCK BlockId
    lbl2
                               , Format -> Reg -> Reg -> Instr
    CNTLZ Format
    II32 Reg
    reg_dst Reg
    vr_hi
                               , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    lbl3 Maybe Bool
    forall a. Maybe a
    Nothing

                               , BlockId -> Instr
    NEWBLOCK BlockId
    lbl3
                               ]
              return $ code `appOL` cntlz
            else do
              let format = if Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 then Format
    II64 else Format
    II32
              (s_reg, s_code) <- getSomeReg src
              (pre, reg , post) <-
                case width of
                  Width
    W64 -> (OrdList Instr, Reg, OrdList Instr)
    -> NatM (OrdList Instr, Reg, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    forall a. OrdList a
    nilOL, Reg
    s_reg, OrdList Instr
    forall a. OrdList a
    nilOL)
                  Width
    W32 -> (OrdList Instr, Reg, OrdList Instr)
    -> NatM (OrdList Instr, Reg, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    forall a. OrdList a
    nilOL, Reg
    s_reg, OrdList Instr
    forall a. OrdList a
    nilOL)
                  Width
    W16 -> do
                    reg_tmp <- Format -> NatM Reg
    getNewRegNat Format
    format
                    return
                      ( unitOL $ AND reg_tmp s_reg (RIImm (ImmInt 65535))
                      , reg_tmp
                      , unitOL $ ADD reg_dst reg_dst (RIImm (ImmInt (-16)))
                      )
                  Width
    W8  -> do
                    reg_tmp <- Format -> NatM Reg
    getNewRegNat Format
    format
                    return
                      ( unitOL $ AND reg_tmp s_reg (RIImm (ImmInt 255))
                      , reg_tmp
                      , unitOL $ ADD reg_dst reg_dst (RIImm (ImmInt (-24)))
                      )
                  Width
    _   -> String -> NatM (OrdList Instr, Reg, OrdList Instr)
    forall a. HasCallStack => String -> a
    panic String
    "genCall: Clz wrong format"
              let cntlz = Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Format -> Reg -> Reg -> Instr
    CNTLZ Format
    format Reg
    reg_dst Reg
    reg)
              return $ s_code `appOL` pre `appOL` cntlz `appOL` post

    genCCall (PrimTarget (MO_Ctz Width
    width)) [CmmFormal
    dst] [CmmExpr
    src]
     = do platform <- NatM Platform
    getPlatform
          let reg_dst = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    dst
          if target32Bit platform && width == W64
            then do
              let format = Format
    II32
              RegCode64 code vr_hi vr_lo <- iselExpr64 src
              lbl1 <- getBlockIdNat
              lbl2 <- getBlockIdNat
              lbl3 <- getBlockIdNat
              x' <- getNewRegNat format
              x'' <- getNewRegNat format
              r' <- getNewRegNat format
              cnttzlo <- cnttz format reg_dst vr_lo
              let cnttz64 = [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Format -> Reg -> RI -> Instr
    CMPL Format
    format Reg
    vr_lo (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    0))
                                 , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    NE BlockId
    lbl2 Maybe Bool
    forall a. Maybe a
    Nothing
                                 , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    lbl1 Maybe Bool
    forall a. Maybe a
    Nothing

                                 , BlockId -> Instr
    NEWBLOCK BlockId
    lbl1
                                 , Reg -> Reg -> RI -> Instr
    ADD Reg
    x' Reg
    vr_hi (Imm -> RI
    RIImm (Int -> Imm
    ImmInt (-Int
    1)))
                                 , Reg -> Reg -> Reg -> Instr
    ANDC Reg
    x'' Reg
    x' Reg
    vr_hi
                                 , Format -> Reg -> Reg -> Instr
    CNTLZ Format
    format Reg
    r' Reg
    x''
                                   -- 32 + (32 - clz(x''))
                                 , Reg -> Reg -> RI -> Instr
    SUBFC Reg
    reg_dst Reg
    r' (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    64))
                                 , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    lbl3 Maybe Bool
    forall a. Maybe a
    Nothing

                                 , BlockId -> Instr
    NEWBLOCK BlockId
    lbl2
                                 ]
                            OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    cnttzlo 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 -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    lbl3 Maybe Bool
    forall a. Maybe a
    Nothing

                                 , BlockId -> Instr
    NEWBLOCK BlockId
    lbl3
                                 ]
              return $ code `appOL` cnttz64
            else do
              let format = if Width
    width Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 then Format
    II64 else Format
    II32
              (s_reg, s_code) <- getSomeReg src
              (reg_ctz, pre_code) <-
                case width of
                  Width
    W64 -> (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    s_reg, OrdList Instr
    forall a. OrdList a
    nilOL)
                  Width
    W32 -> (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    s_reg, OrdList Instr
    forall a. OrdList a
    nilOL)
                  Width
    W16 -> do
                    reg_tmp <- Format -> NatM Reg
    getNewRegNat Format
    format
                    return (reg_tmp, unitOL $ ORIS reg_tmp s_reg (ImmInt 1))
                  Width
    W8  -> do
                    reg_tmp <- Format -> NatM Reg
    getNewRegNat Format
    format
                    return (reg_tmp, unitOL $ OR reg_tmp s_reg (RIImm (ImmInt 256)))
                  Width
    _   -> String -> NatM (Reg, OrdList Instr)
    forall a. HasCallStack => String -> a
    panic String
    "genCall: Ctz wrong format"
              ctz_code <- cnttz format reg_dst reg_ctz
              return $ s_code `appOL` pre_code `appOL` ctz_code
            where
              -- cnttz(x) = sizeof(x) - cntlz(~x & (x - 1))
              -- see Henry S. Warren, Hacker's Delight, p 107
              cnttz :: Format -> Reg -> Reg -> NatM (OrdList Instr)
    cnttz Format
    format Reg
    dst Reg
    src = do
                let format_bits :: Int
    format_bits = Int
    8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Format -> Int
    formatInBytes Format
    format
                x' <- Format -> NatM Reg
    getNewRegNat Format
    format
                x'' <- getNewRegNat format
                r' <- getNewRegNat format
                return $ toOL [ ADD x' src (RIImm (ImmInt (-1)))
                              , ANDC x'' x' src
                              , CNTLZ format r' x''
                              , SUBFC dst r' (RIImm (ImmInt (format_bits)))
                              ]

    genCCall ForeignTarget
    target [CmmFormal]
    dest_regs [CmmExpr]
    argsAndHints
     = do platform <- NatM Platform
    getPlatform
          case target of
            PrimTarget (MO_S_QuotRem  Width
    width) -> Bool -> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    divOp1 Bool
    True  Width
    width
                                                       [CmmFormal]
    dest_regs [CmmExpr]
    argsAndHints
            PrimTarget (MO_U_QuotRem  Width
    width) -> Bool -> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    divOp1 Bool
    False Width
    width
                                                       [CmmFormal]
    dest_regs [CmmExpr]
    argsAndHints
            PrimTarget (MO_U_QuotRem2 Width
    width) -> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    divOp2 Width
    width [CmmFormal]
    dest_regs
                                                       [CmmExpr]
    argsAndHints
            PrimTarget (MO_U_Mul2 Width
    width) -> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    multOp2 Width
    width [CmmFormal]
    dest_regs
                                                    [CmmExpr]
    argsAndHints
            PrimTarget (MO_Add2 Width
    _) -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    add2Op [CmmFormal]
    dest_regs [CmmExpr]
    argsAndHints
            PrimTarget (MO_AddWordC Width
    _) -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    addcOp [CmmFormal]
    dest_regs [CmmExpr]
    argsAndHints
            PrimTarget (MO_SubWordC Width
    _) -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    subcOp [CmmFormal]
    dest_regs [CmmExpr]
    argsAndHints
            PrimTarget (MO_AddIntC Width
    width) -> (Reg -> Reg -> Reg -> Instr)
    -> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    addSubCOp Reg -> Reg -> Reg -> Instr
    ADDO Width
    width
                                                       [CmmFormal]
    dest_regs [CmmExpr]
    argsAndHints
            PrimTarget (MO_SubIntC Width
    width) -> (Reg -> Reg -> Reg -> Instr)
    -> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    addSubCOp Reg -> Reg -> Reg -> Instr
    SUBFO Width
    width
                                                       [CmmFormal]
    dest_regs [CmmExpr]
    argsAndHints
            PrimTarget CallishMachOp
    MO_F64_Fabs -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    fabs [CmmFormal]
    dest_regs [CmmExpr]
    argsAndHints
            PrimTarget CallishMachOp
    MO_F32_Fabs -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    fabs [CmmFormal]
    dest_regs [CmmExpr]
    argsAndHints
            ForeignTarget
    _ -> do config <- NatM NCGConfig
    getConfig
                    genCCall' config (platformToGCP platform)
                           target dest_regs argsAndHints
            where divOp1 :: Bool -> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    divOp1 Bool
    signed Width
    width [CmmFormal
    res_q, CmmFormal
    res_r] [CmmExpr
    arg_x, CmmExpr
    arg_y]
                    = do let reg_q :: Reg
    reg_q = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    res_q
                             reg_r :: Reg
    reg_r = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    res_r
                         Width
    -> Bool -> Reg -> CmmExpr -> CmmExpr -> NatM (Reg -> OrdList Instr)
    remainderCode Width
    width Bool
    signed Reg
    reg_q CmmExpr
    arg_x CmmExpr
    arg_y
                           NatM (Reg -> OrdList Instr) -> NatM Reg -> NatM (OrdList Instr)
    forall a b. NatM (a -> b) -> NatM a -> NatM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Reg -> NatM Reg
    forall a. a -> NatM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Reg
    reg_r

                  divOp1 Bool
    _ Width
    _ [CmmFormal]
    _ [CmmExpr]
    _
                    = String -> NatM (OrdList Instr)
    forall a. HasCallStack => String -> a
    panic String
    "genCCall: Wrong number of arguments for divOp1"
                  divOp2 :: Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    divOp2 Width
    width [CmmFormal
    res_q, CmmFormal
    res_r]
                                        [CmmExpr
    arg_x_high, CmmExpr
    arg_x_low, CmmExpr
    arg_y]
                    = do let reg_q :: Reg
    reg_q = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    res_q
                             reg_r :: Reg
    reg_r = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    res_r
                             fmt :: Format
    fmt   = Width -> Format
    intFormat Width
    width
                             half :: Int
    half  = Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Format -> Int
    formatInBytes Format
    fmt)
                         (xh_reg, xh_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    arg_x_high
                         (xl_reg, xl_code) <- getSomeReg arg_x_low
                         (y_reg, y_code) <- getSomeReg arg_y
                         s <- getNewRegNat fmt
                         b <- getNewRegNat fmt
                         v <- getNewRegNat fmt
                         vn1 <- getNewRegNat fmt
                         vn0 <- getNewRegNat fmt
                         un32 <- getNewRegNat fmt
                         tmp  <- getNewRegNat fmt
                         un10 <- getNewRegNat fmt
                         un1 <- getNewRegNat fmt
                         un0 <- getNewRegNat fmt
                         q1 <- getNewRegNat fmt
                         rhat <- getNewRegNat fmt
                         tmp1 <- getNewRegNat fmt
                         q0 <- getNewRegNat fmt
                         un21 <- getNewRegNat fmt
                         again1 <- getBlockIdNat
                         no1 <- getBlockIdNat
                         then1 <- getBlockIdNat
                         endif1 <- getBlockIdNat
                         again2 <- getBlockIdNat
                         no2 <- getBlockIdNat
                         then2 <- getBlockIdNat
                         endif2 <- getBlockIdNat
                         return $ y_code `appOL` xl_code `appOL` xh_code `appOL`
                                  -- see Hacker's Delight p 196 Figure 9-3
                                  toOL [ -- b = 2 ^ (bits_in_word / 2)
                                         LI b (ImmInt 1)
                                       , SL fmt b b (RIImm (ImmInt half))
                                         -- s = clz(y)
                                       , CNTLZ fmt s y_reg
                                         -- v = y << s
                                       , SL fmt v y_reg (RIReg s)
                                         -- vn1 = upper half of v
                                       , SR fmt vn1 v (RIImm (ImmInt half))
                                         -- vn0 = lower half of v
                                       , CLRLI fmt vn0 v half
                                         -- un32 = (u1 << s)
                                         --      | (u0 >> (bits_in_word - s))
                                       , SL fmt un32 xh_reg (RIReg s)
                                       , SUBFC tmp s
                                            (RIImm (ImmInt (8 * formatInBytes fmt)))
                                       , SR fmt tmp xl_reg (RIReg tmp)
                                       , OR un32 un32 (RIReg tmp)
                                         -- un10 = u0 << s
                                       , SL fmt un10 xl_reg (RIReg s)
                                         -- un1 = upper half of un10
                                       , SR fmt un1 un10 (RIImm (ImmInt half))
                                         -- un0 = lower half of un10
                                       , CLRLI fmt un0 un10 half
                                         -- q1 = un32/vn1
                                       , DIV fmt False q1 un32 vn1
                                         -- rhat = un32 - q1*vn1
                                       , MULL fmt tmp q1 (RIReg vn1)
                                       , SUBF rhat tmp un32
                                       , BCC ALWAYS again1 Nothing

                                       , NEWBLOCK again1
                                         -- if (q1 >= b || q1*vn0 > b*rhat + un1)
                                       , CMPL fmt q1 (RIReg b)
                                       , BCC GEU then1 Nothing
                                       , BCC ALWAYS no1 Nothing

                                       , NEWBLOCK no1
                                       , MULL fmt tmp q1 (RIReg vn0)
                                       , SL fmt tmp1 rhat (RIImm (ImmInt half))
                                       , ADD tmp1 tmp1 (RIReg un1)
                                       , CMPL fmt tmp (RIReg tmp1)
                                       , BCC LEU endif1 Nothing
                                       , BCC ALWAYS then1 Nothing

                                       , NEWBLOCK then1
                                         -- q1 = q1 - 1
                                       , ADD q1 q1 (RIImm (ImmInt (-1)))
                                         -- rhat = rhat + vn1
                                       , ADD rhat rhat (RIReg vn1)
                                         -- if (rhat < b) goto again1
                                       , CMPL fmt rhat (RIReg b)
                                       , BCC LTT again1 Nothing
                                       , BCC ALWAYS endif1 Nothing

                                       , NEWBLOCK endif1
                                         -- un21 = un32*b + un1 - q1*v
                                       , SL fmt un21 un32 (RIImm (ImmInt half))
                                       , ADD un21 un21 (RIReg un1)
                                       , MULL fmt tmp q1 (RIReg v)
                                       , SUBF un21 tmp un21
                                         -- compute second quotient digit
                                         -- q0 = un21/vn1
                                       , DIV fmt False q0 un21 vn1
                                         -- rhat = un21- q0*vn1
                                       , MULL fmt tmp q0 (RIReg vn1)
                                       , SUBF rhat tmp un21
                                       , BCC ALWAYS again2 Nothing

                                       , NEWBLOCK again2
                                         -- if (q0>b || q0*vn0 > b*rhat + un0)
                                       , CMPL fmt q0 (RIReg b)
                                       , BCC GEU then2 Nothing
                                       , BCC ALWAYS no2 Nothing

                                       , NEWBLOCK no2
                                       , MULL fmt tmp q0 (RIReg vn0)
                                       , SL fmt tmp1 rhat (RIImm (ImmInt half))
                                       , ADD tmp1 tmp1 (RIReg un0)
                                       , CMPL fmt tmp (RIReg tmp1)
                                       , BCC LEU endif2 Nothing
                                       , BCC ALWAYS then2 Nothing

                                       , NEWBLOCK then2
                                         -- q0 = q0 - 1
                                       , ADD q0 q0 (RIImm (ImmInt (-1)))
                                         -- rhat = rhat + vn1
                                       , ADD rhat rhat (RIReg vn1)
                                         -- if (rhat<b) goto again2
                                       , CMPL fmt rhat (RIReg b)
                                       , BCC LTT again2 Nothing
                                       , BCC ALWAYS endif2 Nothing

                                       , NEWBLOCK endif2
                                         -- compute remainder
                                         -- r = (un21*b + un0 - q0*v) >> s
                                       , SL fmt reg_r un21 (RIImm (ImmInt half))
                                       , ADD reg_r reg_r (RIReg un0)
                                       , MULL fmt tmp q0 (RIReg v)
                                       , SUBF reg_r tmp reg_r
                                       , SR fmt reg_r reg_r (RIReg s)
                                         -- compute quotient
                                         -- q = q1*b + q0
                                       , SL fmt reg_q q1 (RIImm (ImmInt half))
                                       , ADD reg_q reg_q (RIReg q0)
                                       ]
                  divOp2 Width
    _ [CmmFormal]
    _ [CmmExpr]
    _
                    = String -> NatM (OrdList Instr)
    forall a. HasCallStack => String -> a
    panic String
    "genCCall: Wrong number of arguments for divOp2"
                  multOp2 :: Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    multOp2 Width
    width [CmmFormal
    res_h, CmmFormal
    res_l] [CmmExpr
    arg_x, CmmExpr
    arg_y]
                    = do let reg_h :: Reg
    reg_h = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    res_h
                             reg_l :: Reg
    reg_l = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    res_l
                             fmt :: Format
    fmt = Width -> Format
    intFormat Width
    width
                         (x_reg, x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    arg_x
                         (y_reg, y_code) <- getSomeReg arg_y
                         return $ y_code `appOL` x_code
                                `appOL` toOL [ MULL fmt reg_l x_reg (RIReg y_reg)
                                             , MULHU fmt reg_h x_reg y_reg
                                             ]
                  multOp2 Width
    _ [CmmFormal]
    _ [CmmExpr]
    _
                    = String -> NatM (OrdList Instr)
    forall a. HasCallStack => String -> a
    panic String
    "genCall: Wrong number of arguments for multOp2"
                  add2Op :: [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    add2Op [CmmFormal
    res_h, CmmFormal
    res_l] [CmmExpr
    arg_x, CmmExpr
    arg_y]
                    = do let reg_h :: Reg
    reg_h = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    res_h
                             reg_l :: Reg
    reg_l = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    res_l
                         (x_reg, x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    arg_x
                         (y_reg, y_code) <- getSomeReg arg_y
                         return $ y_code `appOL` x_code
                                `appOL` toOL [ LI reg_h (ImmInt 0)
                                             , ADDC reg_l x_reg y_reg
                                             , ADDZE reg_h reg_h
                                             ]
                  add2Op [CmmFormal]
    _ [CmmExpr]
    _
                    = String -> NatM (OrdList Instr)
    forall a. HasCallStack => String -> a
    panic String
    "genCCall: Wrong number of arguments/results for add2"

                  addcOp :: [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    addcOp [CmmFormal
    res_r, CmmFormal
    res_c] [CmmExpr
    arg_x, CmmExpr
    arg_y]
                    = [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    add2Op [CmmFormal
    res_c {-hi-}, CmmFormal
    res_r {-lo-}] [CmmExpr
    arg_x, CmmExpr
    arg_y]
                  addcOp [CmmFormal]
    _ [CmmExpr]
    _
                    = String -> NatM (OrdList Instr)
    forall a. HasCallStack => String -> a
    panic String
    "genCCall: Wrong number of arguments/results for addc"

                  -- PowerPC subfc sets the carry for rT = ~(rA) + rB + 1,
                  -- which is 0 for borrow and 1 otherwise. We need 1 and 0
                  -- so xor with 1.
                  subcOp :: [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    subcOp [CmmFormal
    res_r, CmmFormal
    res_c] [CmmExpr
    arg_x, CmmExpr
    arg_y]
                    = do let reg_r :: Reg
    reg_r = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    res_r
                             reg_c :: Reg
    reg_c = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    res_c
                         (x_reg, x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    arg_x
                         (y_reg, y_code) <- getSomeReg arg_y
                         return $ y_code `appOL` x_code
                                `appOL` toOL [ LI reg_c (ImmInt 0)
                                             , SUBFC reg_r y_reg (RIReg x_reg)
                                             , ADDZE reg_c reg_c
                                             , XOR reg_c reg_c (RIImm (ImmInt 1))
                                             ]
                  subcOp [CmmFormal]
    _ [CmmExpr]
    _
                    = String -> NatM (OrdList Instr)
    forall a. HasCallStack => String -> a
    panic String
    "genCCall: Wrong number of arguments/results for subc"
                  addSubCOp :: (Reg -> Reg -> Reg -> Instr)
    -> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    addSubCOp Reg -> Reg -> Reg -> Instr
    instr Width
    width [CmmFormal
    res_r, CmmFormal
    res_c] [CmmExpr
    arg_x, CmmExpr
    arg_y]
                    = do let reg_r :: Reg
    reg_r = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    res_r
                             reg_c :: Reg
    reg_c = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    res_c
                         (x_reg, x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    arg_x
                         (y_reg, y_code) <- getSomeReg arg_y
                         return $ y_code `appOL` x_code
                                `appOL` toOL [ instr reg_r y_reg x_reg,
                                               -- SUBFO argument order reversed!
                                               MFOV (intFormat width) reg_c
                                             ]
                  addSubCOp Reg -> Reg -> Reg -> Instr
    _ Width
    _ [CmmFormal]
    _ [CmmExpr]
    _
                    = String -> NatM (OrdList Instr)
    forall a. HasCallStack => String -> a
    panic String
    "genCall: Wrong number of arguments/results for addC"
                  fabs :: [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    fabs [CmmFormal
    res] [CmmExpr
    arg]
                    = do let res_r :: Reg
    res_r = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    res
                         (arg_reg, arg_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    arg
                         return $ arg_code `snocOL` FABS res_r arg_reg
                  fabs [CmmFormal]
    _ [CmmExpr]
    _
                    = String -> NatM (OrdList Instr)
    forall a. HasCallStack => String -> a
    panic String
    "genCall: Wrong number of arguments/results for fabs"

    -- TODO: replace 'Int' by an enum such as 'PPC_64ABI'
    data GenCCallPlatform = GCP32ELF | GCP64ELF !Int | GCPAIX

    platformToGCP :: Platform -> GenCCallPlatform
    platformToGCP :: Platform -> GenCCallPlatform
    platformToGCP Platform
    platform
      = case Platform -> OS
    platformOS Platform
    platform of
          OS
    OSAIX    -> GenCCallPlatform
    GCPAIX
          OS
    _ -> case Platform -> Arch
    platformArch Platform
    platform of
                 Arch
    ArchPPC           -> GenCCallPlatform
    GCP32ELF
                 ArchPPC_64 PPC_64ABI
    ELF_V1 -> Int -> GenCCallPlatform
    GCP64ELF Int
    1
                 ArchPPC_64 PPC_64ABI
    ELF_V2 -> Int -> GenCCallPlatform
    GCP64ELF Int
    2
                 Arch
    _ -> String -> GenCCallPlatform
    forall a. HasCallStack => String -> a
    panic String
    "platformToGCP: Not PowerPC"

    genCCall'
        :: NCGConfig
        -> GenCCallPlatform
        -> ForeignTarget            -- function to call
        -> [CmmFormal]        -- where to put the result
        -> [CmmActual]        -- arguments (of mixed type)
        -> NatM InstrBlock

    {-
        PowerPC Linux uses the System V Release 4 Calling Convention
        for PowerPC. It is described in the
        "System V Application Binary Interface PowerPC Processor Supplement".

        PowerPC 64 Linux uses the System V Release 4 Calling Convention for
        64-bit PowerPC. It is specified in
        "64-bit PowerPC ELF Application Binary Interface Supplement 1.9"
        (PPC64 ELF v1.9).

        PowerPC 64 Linux in little endian mode uses the "Power Architecture 64-Bit
        ELF V2 ABI Specification -- OpenPOWER ABI for Linux Supplement"
        (PPC64 ELF v2).

        AIX follows the "PowerOpen ABI: Application Binary Interface Big-Endian
        32-Bit Hardware Implementation"

        All four conventions are similar:
        Parameters may be passed in general-purpose registers starting at r3, in
        floating point registers starting at f1, or on the stack.

        But there are substantial differences:
        * The number of registers used for parameter passing and the exact set of
          nonvolatile registers differs (see MachRegs.hs).
        * On AIX and 64-bit ELF, stack space is always reserved for parameters,
          even if they are passed in registers. The called routine may choose to
          save parameters from registers to the corresponding space on the stack.
        * On AIX and 64-bit ELF, a corresponding amount of GPRs is skipped when
          a floating point parameter is passed in an FPR.
        * SysV insists on either passing I64 arguments on the stack, or in two GPRs,
          starting with an odd-numbered GPR. It may skip a GPR to achieve this.
          AIX just treats an I64 likt two separate I32s (high word first).
        * I64 and FF64 arguments are 8-byte aligned on the stack for SysV, but only
          4-byte aligned like everything else on AIX.
        * The SysV spec claims that FF32 is represented as FF64 on the stack. GCC on
          PowerPC Linux does not agree, so neither do we.

        According to all conventions, the parameter area should be part of the
        caller's stack frame, allocated in the caller's prologue code (large enough
        to hold the parameter lists for all called routines). The NCG already
        uses the stack for register spilling, leaving 64 bytes free at the top.
        If we need a larger parameter area than that, we increase the size
        of the stack frame just before ccalling.
    -}

    genCCall' :: NCGConfig
    -> GenCCallPlatform
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> NatM (OrdList Instr)
    genCCall' NCGConfig
    config GenCCallPlatform
    gcp ForeignTarget
    target [CmmFormal]
    dest_regs [CmmExpr]
    args
      = do
            (finalStack,passArgumentsCode,usedRegs) <- [(CmmExpr, CmmType, ForeignHint)]
    -> [Reg]
    -> [Reg]
    -> Int
    -> OrdList Instr
    -> [Reg]
    -> NatM (Int, OrdList Instr, [Reg])
    passArguments
                                                       ([CmmExpr]
    -> [CmmType] -> [ForeignHint] -> [(CmmExpr, CmmType, ForeignHint)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [CmmExpr]
    args [CmmType]
    argReps [ForeignHint]
    argHints)
                                                       [Reg]
    allArgRegs
                                                       (Platform -> [Reg]
    allFPArgRegs Platform
    platform)
                                                       Int
    initialStackOffset
                                                       OrdList Instr
    forall a. OrdList a
    nilOL []

            (labelOrExpr, reduceToFF32) <- case target of
                ForeignTarget (CmmLit (CmmLabel CLabel
    lbl)) ForeignConvention
    _ -> do
                    NatM ()
    uses_pic_base_implicitly
                    (Either CLabel CmmExpr, Bool) -> NatM (Either CLabel CmmExpr, Bool)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CLabel -> Either CLabel CmmExpr
    forall a b. a -> Either a b
    Left CLabel
    lbl, Bool
    False)
                ForeignTarget CmmExpr
    expr ForeignConvention
    _ -> do
                    NatM ()
    uses_pic_base_implicitly
                    (Either CLabel CmmExpr, Bool) -> NatM (Either CLabel CmmExpr, Bool)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmExpr -> Either CLabel CmmExpr
    forall a b. b -> Either a b
    Right CmmExpr
    expr, Bool
    False)
                PrimTarget CallishMachOp
    mop -> CallishMachOp -> NatM (Either CLabel CmmExpr, Bool)
    outOfLineMachOp CallishMachOp
    mop

            let codeBefore = Int -> OrdList Instr
    move_sp_down Int
    finalStack OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    passArgumentsCode
                codeAfter = Int -> OrdList Instr
    move_sp_up Int
    finalStack OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Bool -> OrdList Instr
    moveResult Bool
    reduceToFF32

            case labelOrExpr of
                Left CLabel
    lbl -> -- the linker does all the work for us
                    OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (         OrdList Instr
    codeBefore
                            OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` CLabel -> [Reg] -> Instr
    BL CLabel
    lbl [Reg]
    usedRegs
                            OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    maybeNOP -- some ABI require a NOP after BL
                            OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    codeAfter)
                Right CmmExpr
    dyn -> do -- implement call through function pointer
                    (dynReg, dynCode) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    dyn
                    case gcp of
                         GCP64ELF Int
    1      -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( OrdList Instr
    dynCode
                           OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    codeBefore
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    ST Format
    spFormat Reg
    toc (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    sp (Int -> Imm
    ImmInt Int
    40))
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II64 Reg
    r11 (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    dynReg (Int -> Imm
    ImmInt Int
    0))
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II64 Reg
    toc (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    dynReg (Int -> Imm
    ImmInt Int
    8))
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Instr
    MTCTR Reg
    r11
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II64 Reg
    r11 (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    dynReg (Int -> Imm
    ImmInt Int
    16))
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` [Reg] -> Instr
    BCTRL [Reg]
    usedRegs
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    spFormat Reg
    toc (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    sp (Int -> Imm
    ImmInt Int
    40))
                           OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    codeAfter)
                         GCP64ELF Int
    2      -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( OrdList Instr
    dynCode
                           OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    codeBefore
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    ST Format
    spFormat Reg
    toc (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    sp (Int -> Imm
    ImmInt Int
    24))
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Instr
    MR Reg
    r12 Reg
    dynReg
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Instr
    MTCTR Reg
    r12
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` [Reg] -> Instr
    BCTRL [Reg]
    usedRegs
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    spFormat Reg
    toc (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    sp (Int -> Imm
    ImmInt Int
    24))
                           OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    codeAfter)
                         GenCCallPlatform
    GCPAIX          -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( OrdList Instr
    dynCode
                           -- AIX/XCOFF follows the PowerOPEN ABI
                           -- which is quite similar to LinuxPPC64/ELFv1
                           OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    codeBefore
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    ST Format
    spFormat Reg
    toc (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    sp (Int -> Imm
    ImmInt Int
    20))
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II32 Reg
    r11 (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    dynReg (Int -> Imm
    ImmInt Int
    0))
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II32 Reg
    toc (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    dynReg (Int -> Imm
    ImmInt Int
    4))
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Instr
    MTCTR Reg
    r11
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II32 Reg
    r11 (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    dynReg (Int -> Imm
    ImmInt Int
    8))
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` [Reg] -> Instr
    BCTRL [Reg]
    usedRegs
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    spFormat Reg
    toc (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    sp (Int -> Imm
    ImmInt Int
    20))
                           OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    codeAfter)
                         GenCCallPlatform
    _               -> OrdList Instr -> NatM (OrdList Instr)
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( OrdList Instr
    dynCode
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Instr
    MTCTR Reg
    dynReg
                           OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    codeBefore
                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` [Reg] -> Instr
    BCTRL [Reg]
    usedRegs
                           OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    codeAfter)
        where
            platform :: Platform
    platform = NCGConfig -> Platform
    ncgPlatform NCGConfig
    config

            uses_pic_base_implicitly :: NatM ()
    uses_pic_base_implicitly =
                -- See Note [implicit register in PPC PIC code]
                -- on why we claim to use PIC register here
                Bool -> NatM () -> NatM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (NCGConfig -> Bool
    ncgPIC NCGConfig
    config Bool -> Bool -> Bool
    && Platform -> Bool
    target32Bit Platform
    platform) (NatM () -> NatM ()) -> NatM () -> NatM ()
    forall a b. (a -> b) -> a -> b
    $ do
                    _ <- Format -> NatM Reg
    getPicBaseNat (Format -> NatM Reg) -> Format -> NatM Reg
    forall a b. (a -> b) -> a -> b
    $ Bool -> Format
    archWordFormat Bool
    True
                    return ()

            initialStackOffset :: Int
    initialStackOffset = case GenCCallPlatform
    gcp of
                                 GenCCallPlatform
    GCPAIX     -> Int
    24
                                 GenCCallPlatform
    GCP32ELF   -> Int
    8
                                 GCP64ELF Int
    1 -> Int
    48
                                 GCP64ELF Int
    2 -> Int
    32
                                 GenCCallPlatform
    _ -> String -> Int
    forall a. HasCallStack => String -> a
    panic String
    "genCall': unknown calling convention"
                -- size of linkage area + size of arguments, in bytes
            stackDelta :: Int -> Int
    stackDelta Int
    finalStack = case GenCCallPlatform
    gcp of
                                    GenCCallPlatform
    GCPAIX ->
                                        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
    24 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +) (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    32 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $
                                        (CmmType -> Int) -> [CmmType] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (Width -> Int
    widthInBytes (Width -> Int) -> (CmmType -> Width) -> CmmType -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmType -> Width
    typeWidth) [CmmType]
    argReps
                                    GenCCallPlatform
    GCP32ELF -> Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    roundTo Int
    16 Int
    finalStack
                                    GCP64ELF Int
    1 ->
                                        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
    48 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +) (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    64 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $
                                        (CmmType -> Int) -> [CmmType] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    roundTo Int
    8 (Int -> Int) -> (CmmType -> Int) -> CmmType -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Width -> Int
    widthInBytes (Width -> Int) -> (CmmType -> Width) -> CmmType -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmType -> Width
    typeWidth)
                                            [CmmType]
    argReps
                                    GCP64ELF Int
    2 ->
                                        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
    32 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +) (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    64 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $
                                        (CmmType -> Int) -> [CmmType] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    roundTo Int
    8 (Int -> Int) -> (CmmType -> Int) -> CmmType -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Width -> Int
    widthInBytes (Width -> Int) -> (CmmType -> Width) -> CmmType -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmType -> Width
    typeWidth)
                                            [CmmType]
    argReps
                                    GenCCallPlatform
    _ -> String -> Int
    forall a. HasCallStack => String -> a
    panic String
    "genCall': unknown calling conv."

            argReps :: [CmmType]
    argReps = (CmmExpr -> CmmType) -> [CmmExpr] -> [CmmType]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform) [CmmExpr]
    args
            ([ForeignHint]
    _, [ForeignHint]
    argHints) = ForeignTarget -> ([ForeignHint], [ForeignHint])
    foreignTargetHints ForeignTarget
    target

            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)

            spFormat :: Format
    spFormat = if Platform -> Bool
    target32Bit Platform
    platform then Format
    II32 else Format
    II64

            -- TODO: Do not create a new stack frame if delta is too large.
            move_sp_down :: Int -> OrdList Instr
    move_sp_down Int
    finalStack
                   | Int
    delta Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Platform -> Int
    stackFrameHeaderSize Platform
    platform =
                            [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [Format -> Reg -> AddrMode -> Instr
    STU Format
    spFormat Reg
    sp (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    sp (Int -> Imm
    ImmInt (-Int
    delta))),
                                  Int -> Instr
    DELTA (-Int
    delta)]
                   | Bool
    otherwise = OrdList Instr
    forall a. OrdList a
    nilOL
                   where delta :: Int
    delta = Int -> Int
    stackDelta Int
    finalStack
            move_sp_up :: Int -> OrdList Instr
    move_sp_up Int
    finalStack
                   | Int
    delta Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Platform -> Int
    stackFrameHeaderSize Platform
    platform =
                            [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [Reg -> Reg -> RI -> Instr
    ADD Reg
    sp Reg
    sp (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    delta)),
                                  Int -> Instr
    DELTA Int
    0]
                   | Bool
    otherwise = OrdList Instr
    forall a. OrdList a
    nilOL
                   where delta :: Int
    delta = Int -> Int
    stackDelta Int
    finalStack

            -- A NOP instruction is required after a call (bl instruction)
            -- on AIX and 64-Bit Linux.
            -- If the call is to a function with a different TOC (r2) the
            -- link editor replaces the NOP instruction with a load of the TOC
            -- from the stack to restore the TOC.
            maybeNOP :: OrdList Instr
    maybeNOP = case GenCCallPlatform
    gcp of
               GenCCallPlatform
    GCP32ELF        -> OrdList Instr
    forall a. OrdList a
    nilOL
               -- See Section 3.9.4 of OpenPower ABI
               GenCCallPlatform
    GCPAIX          -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL Instr
    NOP
               -- See Section 3.5.11 of PPC64 ELF v1.9
               GCP64ELF Int
    1      -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL Instr
    NOP
               -- See Section 2.3.6 of PPC64 ELF v2
               GCP64ELF Int
    2      -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL Instr
    NOP
               GenCCallPlatform
    _               -> String -> OrdList Instr
    forall a. HasCallStack => String -> a
    panic String
    "maybeNOP: Unknown PowerPC 64-bit ABI"

            passArguments :: [(CmmExpr, CmmType, ForeignHint)]
    -> [Reg]
    -> [Reg]
    -> Int
    -> OrdList Instr
    -> [Reg]
    -> NatM (Int, OrdList Instr, [Reg])
    passArguments [] [Reg]
    _ [Reg]
    _ Int
    stackOffset OrdList Instr
    accumCode [Reg]
    accumUsed = (Int, OrdList Instr, [Reg]) -> NatM (Int, OrdList Instr, [Reg])
    forall a. a -> NatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    stackOffset, OrdList Instr
    accumCode, [Reg]
    accumUsed)
            passArguments ((CmmExpr
    arg,CmmType
    arg_ty,ForeignHint
    _):[(CmmExpr, CmmType, ForeignHint)]
    args) [Reg]
    gprs [Reg]
    fprs Int
    stackOffset
                   OrdList Instr
    accumCode [Reg]
    accumUsed | CmmType -> Bool
    isWord64 CmmType
    arg_ty
                                         Bool -> Bool -> Bool
    && Platform -> Bool
    target32Bit (NCGConfig -> Platform
    ncgPlatform NCGConfig
    config) =
                do
                    RegCode64 code vr_hi vr_lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
    iselExpr64 CmmExpr
    arg

                    case gcp of
                        GenCCallPlatform
    GCPAIX ->
                            do let storeWord :: Reg -> [Reg] -> Int -> Instr
    storeWord Reg
    vr (Reg
    gpr:[Reg]
    _) Int
    _ = Reg -> Reg -> Instr
    MR Reg
    gpr Reg
    vr
                                   storeWord Reg
    vr [] Int
    offset
                                       = Format -> Reg -> AddrMode -> Instr
    ST Format
    II32 Reg
    vr (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    sp (Int -> Imm
    ImmInt Int
    offset))
                               [(CmmExpr, CmmType, ForeignHint)]
    -> [Reg]
    -> [Reg]
    -> Int
    -> OrdList Instr
    -> [Reg]
    -> NatM (Int, OrdList Instr, [Reg])
    passArguments [(CmmExpr, CmmType, ForeignHint)]
    args
                                             (Int -> [Reg] -> [Reg]
    forall a. Int -> [a] -> [a]
    drop Int
    2 [Reg]
    gprs)
                                             [Reg]
    fprs
                                             (Int
    stackOffsetInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    8)
                                             (OrdList Instr
    accumCode OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code
                                                   OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> [Reg] -> Int -> Instr
    storeWord Reg
    vr_hi [Reg]
    gprs Int
    stackOffset
                                                   OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> [Reg] -> Int -> Instr
    storeWord Reg
    vr_lo (Int -> [Reg] -> [Reg]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [Reg]
    gprs) (Int
    stackOffsetInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    4))
                                             ((Int -> [Reg] -> [Reg]
    forall a. Int -> [a] -> [a]
    take Int
    2 [Reg]
    gprs) [Reg] -> [Reg] -> [Reg]
    forall a. [a] -> [a] -> [a]
    ++ [Reg]
    accumUsed)
                        GenCCallPlatform
    GCP32ELF ->
                            do let stackOffset' :: Int
    stackOffset' = Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    roundTo Int
    8 Int
    stackOffset
                                   stackCode :: OrdList Instr
    stackCode = OrdList Instr
    accumCode OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code
                                       OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    ST Format
    II32 Reg
    vr_hi (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    sp (Int -> Imm
    ImmInt Int
    stackOffset'))
                                       OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    ST Format
    II32 Reg
    vr_lo (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    sp (Int -> Imm
    ImmInt (Int
    stackOffset'Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    4)))
                                   regCode :: Reg -> Reg -> OrdList Instr
    regCode Reg
    hireg Reg
    loreg =
                                       OrdList Instr
    accumCode OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code
                                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Instr
    MR Reg
    hireg Reg
    vr_hi
                                           OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Instr
    MR Reg
    loreg Reg
    vr_lo

                               case [Reg]
    gprs of
                                   Reg
    hireg : Reg
    loreg : [Reg]
    regs | Int -> Bool
    forall a. Integral a => a -> Bool
    even ([Reg] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Reg]
    gprs) ->
                                       [(CmmExpr, CmmType, ForeignHint)]
    -> [Reg]
    -> [Reg]
    -> Int
    -> OrdList Instr
    -> [Reg]
    -> NatM (Int, OrdList Instr, [Reg])
    passArguments [(CmmExpr, CmmType, ForeignHint)]
    args [Reg]
    regs [Reg]
    fprs Int
    stackOffset
                                                     (Reg -> Reg -> OrdList Instr
    regCode Reg
    hireg Reg
    loreg) (Reg
    hireg Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : Reg
    loreg Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : [Reg]
    accumUsed)
                                   Reg
    _skipped : Reg
    hireg : Reg
    loreg : [Reg]
    regs ->
                                       [(CmmExpr, CmmType, ForeignHint)]
    -> [Reg]
    -> [Reg]
    -> Int
    -> OrdList Instr
    -> [Reg]
    -> NatM (Int, OrdList Instr, [Reg])
    passArguments [(CmmExpr, CmmType, ForeignHint)]
    args [Reg]
    regs [Reg]
    fprs Int
    stackOffset
                                                     (Reg -> Reg -> OrdList Instr
    regCode Reg
    hireg Reg
    loreg) (Reg
    hireg Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : Reg
    loreg Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : [Reg]
    accumUsed)
                                   [Reg]
    _ -> -- only one or no regs left
                                       [(CmmExpr, CmmType, ForeignHint)]
    -> [Reg]
    -> [Reg]
    -> Int
    -> OrdList Instr
    -> [Reg]
    -> NatM (Int, OrdList Instr, [Reg])
    passArguments [(CmmExpr, CmmType, ForeignHint)]
    args [] [Reg]
    fprs (Int
    stackOffset'Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    8)
                                                     OrdList Instr
    stackCode [Reg]
    accumUsed
                        GCP64ELF Int
    _ -> String -> NatM (Int, OrdList Instr, [Reg])
    forall a. HasCallStack => String -> a
    panic String
    "passArguments: 32 bit code"

            passArguments ((CmmExpr
    arg,CmmType
    rep,ForeignHint
    hint):[(CmmExpr, CmmType, ForeignHint)]
    args) [Reg]
    gprs [Reg]
    fprs Int
    stackOffset OrdList Instr
    accumCode [Reg]
    accumUsed
                | Reg
    reg : [Reg]
    _ <- [Reg]
    regs = do
                    register <- CmmExpr -> NatM Register
    getRegister CmmExpr
    arg_pro
                    let code = case Register
    register of
                                Fixed Format
    _ Reg
    freg OrdList Instr
    fcode -> OrdList Instr
    fcode OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Instr
    MR Reg
    reg Reg
    freg
                                Any Format
    _ Reg -> OrdList Instr
    acode -> Reg -> OrdList Instr
    acode Reg
    reg
                        stackOffsetRes = case GenCCallPlatform
    gcp of
                                         -- The PowerOpen ABI requires that we
                                         -- reserve stack slots for register
                                         -- parameters
                                         GenCCallPlatform
    GCPAIX    -> Int
    stackOffset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    stackBytes
                                         -- ... the SysV ABI 32-bit doesn't.
                                         GenCCallPlatform
    GCP32ELF -> Int
    stackOffset
                                         -- ... but SysV ABI 64-bit does.
                                         GCP64ELF Int
    _ -> Int
    stackOffset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    stackBytes
                    passArguments args
                                  (drop nGprs gprs)
                                  (drop nFprs fprs)
                                  stackOffsetRes
                                  (accumCode `appOL` code)
                                  (reg : accumUsed)
                | Bool
    otherwise = do
                    (vr, code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    arg_pro
                    passArguments args
                                  (drop nGprs gprs)
                                  (drop nFprs fprs)
                                  (stackOffset' + stackBytes)
                                  (accumCode `appOL` code
                                             `snocOL` ST format_pro vr stackSlot)
                                  accumUsed
                where
                    arg_pro :: CmmExpr
    arg_pro
                       | CmmType -> Bool
    isBitsType CmmType
    rep = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> Width -> MachOp
    conv_op (CmmType -> Width
    typeWidth CmmType
    rep) (Platform -> Width
    wordWidth Platform
    platform)) [CmmExpr
    arg]
                       | Bool
    otherwise      = CmmExpr
    arg
                    format_pro :: Format
    format_pro
                       | CmmType -> Bool
    isBitsType CmmType
    rep = Width -> Format
    intFormat (Platform -> Width
    wordWidth Platform
    platform)
                       | Bool
    otherwise      = CmmType -> Format
    cmmTypeFormat CmmType
    rep
                    conv_op :: Width -> Width -> MachOp
    conv_op = case ForeignHint
    hint of
                                ForeignHint
    SignedHint -> Width -> Width -> MachOp
    MO_SS_Conv
                                ForeignHint
    _          -> Width -> Width -> MachOp
    MO_UU_Conv

                    stackOffset' :: Int
    stackOffset' = case GenCCallPlatform
    gcp of
                                   GenCCallPlatform
    GCPAIX ->
                                       -- The 32bit PowerOPEN ABI is happy with
                                       -- 32bit-alignment ...
                                       Int
    stackOffset
                                   GenCCallPlatform
    GCP32ELF
                                       -- ... the SysV ABI requires 8-byte
                                       -- alignment for doubles.
                                    | CmmType -> Bool
    isFloatType CmmType
    rep Bool -> Bool -> Bool
    && CmmType -> Width
    typeWidth CmmType
    rep Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W64 ->
                                       Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    roundTo Int
    8 Int
    stackOffset
                                    | Bool
    otherwise ->
                                       Int
    stackOffset
                                   GCP64ELF Int
    _ ->
                                       -- Everything on the stack is mapped to
                                       -- 8-byte aligned doublewords
                                       Int
    stackOffset
                    stackOffset'' :: Int
    stackOffset''
                         | CmmType -> Bool
    isFloatType CmmType
    rep Bool -> Bool -> Bool
    && CmmType -> Width
    typeWidth CmmType
    rep Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W32 =
                             case GenCCallPlatform
    gcp of
                             -- The ELF v1 ABI Section 3.2.3 requires:
                             -- "Single precision floating point values
                             -- are mapped to the second word in a single
                             -- doubleword"
                             GCP64ELF Int
    1      -> Int
    stackOffset' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4
                             GenCCallPlatform
    _               -> Int
    stackOffset'
                         | Bool
    otherwise = Int
    stackOffset'

                    stackSlot :: AddrMode
    stackSlot = Reg -> Imm -> AddrMode
    AddrRegImm Reg
    sp (Int -> Imm
    ImmInt Int
    stackOffset'')
                    (Int
    nGprs, Int
    nFprs, Int
    stackBytes, [Reg]
    regs)
                        = case GenCCallPlatform
    gcp of
                          GenCCallPlatform
    GCPAIX ->
                              case CmmType -> Format
    cmmTypeFormat CmmType
    rep of
                              Format
    II8  -> (Int
    1, Int
    0, Int
    4, [Reg]
    gprs)
                              Format
    II16 -> (Int
    1, Int
    0, Int
    4, [Reg]
    gprs)
                              Format
    II32 -> (Int
    1, Int
    0, Int
    4, [Reg]
    gprs)
                              -- The PowerOpen ABI requires that we skip a
                              -- corresponding number of GPRs when we use
                              -- the FPRs.
                              --
                              -- E.g. for a `double` two GPRs are skipped,
                              -- whereas for a `float` one GPR is skipped
                              -- when parameters are assigned to
                              -- registers.
                              --
                              -- The PowerOpen ABI specification can be found at
                              -- ftp://www.sourceware.org/pub/binutils/ppc-docs/ppc-poweropen/
                              Format
    FF32 -> (Int
    1, Int
    1, Int
    4, [Reg]
    fprs)
                              Format
    FF64 -> (Int
    2, Int
    1, Int
    8, [Reg]
    fprs)
                              Format
    II64 -> String -> (Int, Int, Int, [Reg])
    forall a. HasCallStack => String -> a
    panic String
    "genCCall' passArguments II64"

                          GenCCallPlatform
    GCP32ELF ->
                              case CmmType -> Format
    cmmTypeFormat CmmType
    rep of
                              Format
    II8  -> (Int
    1, Int
    0, Int
    4, [Reg]
    gprs)
                              Format
    II16 -> (Int
    1, Int
    0, Int
    4, [Reg]
    gprs)
                              Format
    II32 -> (Int
    1, Int
    0, Int
    4, [Reg]
    gprs)
                              -- ... the SysV ABI doesn't.
                              Format
    FF32 -> (Int
    0, Int
    1, Int
    4, [Reg]
    fprs)
                              Format
    FF64 -> (Int
    0, Int
    1, Int
    8, [Reg]
    fprs)
                              Format
    II64 -> String -> (Int, Int, Int, [Reg])
    forall a. HasCallStack => String -> a
    panic String
    "genCCall' passArguments II64"
                          GCP64ELF Int
    _ ->
                              case CmmType -> Format
    cmmTypeFormat CmmType
    rep of
                              Format
    II8  -> (Int
    1, Int
    0, Int
    8, [Reg]
    gprs)
                              Format
    II16 -> (Int
    1, Int
    0, Int
    8, [Reg]
    gprs)
                              Format
    II32 -> (Int
    1, Int
    0, Int
    8, [Reg]
    gprs)
                              Format
    II64 -> (Int
    1, Int
    0, Int
    8, [Reg]
    gprs)
                              -- The ELFv1 ABI requires that we skip a
                              -- corresponding number of GPRs when we use
                              -- the FPRs.
                              Format
    FF32 -> (Int
    1, Int
    1, Int
    8, [Reg]
    fprs)
                              Format
    FF64 -> (Int
    1, Int
    1, Int
    8, [Reg]
    fprs)

            moveResult :: Bool -> OrdList Instr
    moveResult Bool
    reduceToFF32 =
                case [CmmFormal]
    dest_regs of
                    [] -> OrdList Instr
    forall a. OrdList a
    nilOL
                    [CmmFormal
    dest]
                        | Bool
    reduceToFF32 Bool -> Bool -> Bool
    && CmmType -> Bool
    isFloat32 CmmType
    rep   -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Reg -> Reg -> Instr
    FRSP Reg
    r_dest Reg
    f1)
                        | CmmType -> Bool
    isFloat32 CmmType
    rep Bool -> Bool -> Bool
    || CmmType -> Bool
    isFloat64 CmmType
    rep -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Reg -> Reg -> Instr
    MR Reg
    r_dest Reg
    f1)
                        | CmmType -> Bool
    isWord64 CmmType
    rep Bool -> Bool -> Bool
    && Platform -> Bool
    target32Bit Platform
    platform
                           -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [Reg -> Reg -> Instr
    MR (Reg -> Reg
    getHiVRegFromLo Reg
    r_dest) Reg
    r3,
                                    Reg -> Reg -> Instr
    MR Reg
    r_dest Reg
    r4]
                        | Bool
    otherwise -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Reg -> Reg -> Instr
    MR Reg
    r_dest Reg
    r3)
                        where rep :: CmmType
    rep = CmmReg -> CmmType
    cmmRegType (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dest)
                              r_dest :: Reg
    r_dest = CmmFormal -> Reg
    getLocalRegReg CmmFormal
    dest
                    [CmmFormal]
    _ -> String -> OrdList Instr
    forall a. HasCallStack => String -> a
    panic String
    "genCCall' moveResult: Bad dest_regs"

            outOfLineMachOp :: CallishMachOp -> NatM (Either CLabel CmmExpr, Bool)
    outOfLineMachOp CallishMachOp
    mop =
                do
                    mopExpr <- NCGConfig -> ReferenceKind -> CLabel -> NatM CmmExpr
    forall (m :: * -> *).
    CmmMakeDynamicReferenceM m =>
    NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
    cmmMakeDynamicReference NCGConfig
    config ReferenceKind
    CallReference (CLabel -> NatM CmmExpr) -> CLabel -> NatM CmmExpr
    forall a b. (a -> b) -> a -> b
    $
                                  FastString
    -> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
    mkForeignLabel FastString
    functionName Maybe Int
    forall a. Maybe a
    Nothing ForeignLabelSource
    ForeignLabelInThisPackage FunctionOrData
    IsFunction
                    let mopLabelOrExpr = case CmmExpr
    mopExpr of
                            CmmLit (CmmLabel CLabel
    lbl) -> CLabel -> Either CLabel CmmExpr
    forall a b. a -> Either a b
    Left CLabel
    lbl
                            CmmExpr
    _ -> CmmExpr -> Either CLabel CmmExpr
    forall a b. b -> Either a b
    Right CmmExpr
    mopExpr
                    return (mopLabelOrExpr, reduce)
                where
                    (FastString
    functionName, Bool
    reduce) = case CallishMachOp
    mop of
                        CallishMachOp
    MO_F32_Exp   -> (String -> FastString
    fsLit String
    "exp", Bool
    True)
                        CallishMachOp
    MO_F32_ExpM1 -> (String -> FastString
    fsLit String
    "expm1", Bool
    True)
                        CallishMachOp
    MO_F32_Log   -> (String -> FastString
    fsLit String
    "log", Bool
    True)
                        CallishMachOp
    MO_F32_Log1P -> (String -> FastString
    fsLit String
    "log1p", Bool
    True)
                        CallishMachOp
    MO_F32_Sqrt  -> (String -> FastString
    fsLit String
    "sqrt", Bool
    True)
                        CallishMachOp
    MO_F32_Fabs  -> (FastString, Bool)
    unsupported

                        CallishMachOp
    MO_F32_Sin   -> (String -> FastString
    fsLit String
    "sin", Bool
    True)
                        CallishMachOp
    MO_F32_Cos   -> (String -> FastString
    fsLit String
    "cos", Bool
    True)
                        CallishMachOp
    MO_F32_Tan   -> (String -> FastString
    fsLit String
    "tan", Bool
    True)

                        CallishMachOp
    MO_F32_Asin  -> (String -> FastString
    fsLit String
    "asin", Bool
    True)
                        CallishMachOp
    MO_F32_Acos  -> (String -> FastString
    fsLit String
    "acos", Bool
    True)
                        CallishMachOp
    MO_F32_Atan  -> (String -> FastString
    fsLit String
    "atan", Bool
    True)

                        CallishMachOp
    MO_F32_Sinh  -> (String -> FastString
    fsLit String
    "sinh", Bool
    True)
                        CallishMachOp
    MO_F32_Cosh  -> (String -> FastString
    fsLit String
    "cosh", Bool
    True)
                        CallishMachOp
    MO_F32_Tanh  -> (String -> FastString
    fsLit String
    "tanh", Bool
    True)
                        CallishMachOp
    MO_F32_Pwr   -> (String -> FastString
    fsLit String
    "pow", Bool
    True)

                        CallishMachOp
    MO_F32_Asinh -> (String -> FastString
    fsLit String
    "asinh", Bool
    True)
                        CallishMachOp
    MO_F32_Acosh -> (String -> FastString
    fsLit String
    "acosh", Bool
    True)
                        CallishMachOp
    MO_F32_Atanh -> (String -> FastString
    fsLit String
    "atanh", Bool
    True)

                        CallishMachOp
    MO_F64_Exp   -> (String -> FastString
    fsLit String
    "exp", Bool
    False)
                        CallishMachOp
    MO_F64_ExpM1 -> (String -> FastString
    fsLit String
    "expm1", Bool
    False)
                        CallishMachOp
    MO_F64_Log   -> (String -> FastString
    fsLit String
    "log", Bool
    False)
                        CallishMachOp
    MO_F64_Log1P -> (String -> FastString
    fsLit String
    "log1p", Bool
    False)
                        CallishMachOp
    MO_F64_Sqrt  -> (String -> FastString
    fsLit String
    "sqrt", Bool
    False)
                        CallishMachOp
    MO_F64_Fabs  -> (FastString, Bool)
    unsupported

                        CallishMachOp
    MO_F64_Sin   -> (String -> FastString
    fsLit String
    "sin", Bool
    False)
                        CallishMachOp
    MO_F64_Cos   -> (String -> FastString
    fsLit String
    "cos", Bool
    False)
                        CallishMachOp
    MO_F64_Tan   -> (String -> FastString
    fsLit String
    "tan", Bool
    False)

                        CallishMachOp
    MO_F64_Asin  -> (String -> FastString
    fsLit String
    "asin", Bool
    False)
                        CallishMachOp
    MO_F64_Acos  -> (String -> FastString
    fsLit String
    "acos", Bool
    False)
                        CallishMachOp
    MO_F64_Atan  -> (String -> FastString
    fsLit String
    "atan", Bool
    False)

                        CallishMachOp
    MO_F64_Sinh  -> (String -> FastString
    fsLit String
    "sinh", Bool
    False)
                        CallishMachOp
    MO_F64_Cosh  -> (String -> FastString
    fsLit String
    "cosh", Bool
    False)
                        CallishMachOp
    MO_F64_Tanh  -> (String -> FastString
    fsLit String
    "tanh", Bool
    False)
                        CallishMachOp
    MO_F64_Pwr   -> (String -> FastString
    fsLit String
    "pow", Bool
    False)

                        CallishMachOp
    MO_F64_Asinh -> (String -> FastString
    fsLit String
    "asinh", Bool
    False)
                        CallishMachOp
    MO_F64_Acosh -> (String -> FastString
    fsLit String
    "acosh", Bool
    False)
                        CallishMachOp
    MO_F64_Atanh -> (String -> FastString
    fsLit String
    "atanh", Bool
    False)

                        CallishMachOp
    MO_I64_ToI   -> (String -> FastString
    fsLit String
    "hs_int64ToInt", Bool
    False)
                        CallishMachOp
    MO_I64_FromI -> (String -> FastString
    fsLit String
    "hs_intToInt64", Bool
    False)
                        CallishMachOp
    MO_W64_ToW   -> (String -> FastString
    fsLit String
    "hs_word64ToWord", Bool
    False)
                        CallishMachOp
    MO_W64_FromW -> (String -> FastString
    fsLit String
    "hs_wordToWord64", Bool
    False)

                        CallishMachOp
    MO_x64_Neg   -> (String -> FastString
    fsLit String
    "hs_neg64", Bool
    False)
                        CallishMachOp
    MO_x64_Add   -> (String -> FastString
    fsLit String
    "hs_add64", Bool
    False)
                        CallishMachOp
    MO_x64_Sub   -> (String -> FastString
    fsLit String
    "hs_sub64", Bool
    False)
                        CallishMachOp
    MO_x64_Mul   -> (String -> FastString
    fsLit String
    "hs_mul64", Bool
    False)
                        CallishMachOp
    MO_I64_Quot  -> (String -> FastString
    fsLit String
    "hs_quotInt64", Bool
    False)
                        CallishMachOp
    MO_I64_Rem   -> (String -> FastString
    fsLit String
    "hs_remInt64", Bool
    False)
                        CallishMachOp
    MO_W64_Quot  -> (String -> FastString
    fsLit String
    "hs_quotWord64", Bool
    False)
                        CallishMachOp
    MO_W64_Rem   -> (String -> FastString
    fsLit String
    "hs_remWord64", Bool
    False)

                        CallishMachOp
    MO_x64_And   -> (String -> FastString
    fsLit String
    "hs_and64", Bool
    False)
                        CallishMachOp
    MO_x64_Or    -> (String -> FastString
    fsLit String
    "hs_or64", Bool
    False)
                        CallishMachOp
    MO_x64_Xor   -> (String -> FastString
    fsLit String
    "hs_xor64", Bool
    False)
                        CallishMachOp
    MO_x64_Not   -> (String -> FastString
    fsLit String
    "hs_not64", Bool
    False)
                        CallishMachOp
    MO_x64_Shl   -> (String -> FastString
    fsLit String
    "hs_uncheckedShiftL64", Bool
    False)
                        CallishMachOp
    MO_I64_Shr   -> (String -> FastString
    fsLit String
    "hs_uncheckedIShiftRA64", Bool
    False)
                        CallishMachOp
    MO_W64_Shr   -> (String -> FastString
    fsLit String
    "hs_uncheckedShiftRL64", Bool
    False)

                        CallishMachOp
    MO_x64_Eq    -> (String -> FastString
    fsLit String
    "hs_eq64", Bool
    False)
                        CallishMachOp
    MO_x64_Ne    -> (String -> FastString
    fsLit String
    "hs_ne64", Bool
    False)
                        CallishMachOp
    MO_I64_Ge    -> (String -> FastString
    fsLit String
    "hs_geInt64", Bool
    False)
                        CallishMachOp
    MO_I64_Gt    -> (String -> FastString
    fsLit String
    "hs_gtInt64", Bool
    False)
                        CallishMachOp
    MO_I64_Le    -> (String -> FastString
    fsLit String
    "hs_leInt64", Bool
    False)
                        CallishMachOp
    MO_I64_Lt    -> (String -> FastString
    fsLit String
    "hs_ltInt64", Bool
    False)
                        CallishMachOp
    MO_W64_Ge    -> (String -> FastString
    fsLit String
    "hs_geWord64", Bool
    False)
                        CallishMachOp
    MO_W64_Gt    -> (String -> FastString
    fsLit String
    "hs_gtWord64", Bool
    False)
                        CallishMachOp
    MO_W64_Le    -> (String -> FastString
    fsLit String
    "hs_leWord64", Bool
    False)
                        CallishMachOp
    MO_W64_Lt    -> (String -> FastString
    fsLit String
    "hs_ltWord64", Bool
    False)

                        MO_UF_Conv Width
    w -> (Width -> FastString
    word2FloatLabel Width
    w, Bool
    False)

                        MO_Memcpy Int
    _  -> (String -> FastString
    fsLit String
    "memcpy", Bool
    False)
                        MO_Memset Int
    _  -> (String -> FastString
    fsLit String
    "memset", Bool
    False)
                        MO_Memmove Int
    _ -> (String -> FastString
    fsLit String
    "memmove", Bool
    False)
                        MO_Memcmp Int
    _  -> (String -> FastString
    fsLit String
    "memcmp", Bool
    False)

                        CallishMachOp
    MO_SuspendThread -> (String -> FastString
    fsLit String
    "suspendThread", Bool
    False)
                        CallishMachOp
    MO_ResumeThread  -> (String -> FastString
    fsLit String
    "resumeThread", Bool
    False)

                        MO_BSwap Width
    w   -> (Width -> FastString
    bSwapLabel Width
    w, Bool
    False)
                        MO_BRev Width
    w    -> (Width -> FastString
    bRevLabel Width
    w, Bool
    False)
                        MO_PopCnt Width
    w  -> (Width -> FastString
    popCntLabel Width
    w, Bool
    False)
                        MO_Pdep Width
    w    -> (Width -> FastString
    pdepLabel Width
    w, Bool
    False)
                        MO_Pext Width
    w    -> (Width -> FastString
    pextLabel Width
    w, Bool
    False)
                        MO_Clz Width
    _     -> (FastString, Bool)
    unsupported
                        MO_Ctz Width
    _     -> (FastString, Bool)
    unsupported
                        MO_AtomicRMW {} -> (FastString, Bool)
    unsupported
                        MO_Cmpxchg Width
    w -> (Width -> FastString
    cmpxchgLabel Width
    w, Bool
    False)
                        MO_Xchg Width
    w    -> (Width -> FastString
    xchgLabel Width
    w, Bool
    False)
                        MO_AtomicRead Width
    _ MemoryOrdering
    _  -> (FastString, Bool)
    unsupported
                        MO_AtomicWrite Width
    _ MemoryOrdering
    _ -> (FastString, Bool)
    unsupported

                        MO_S_Mul2    {}  -> (FastString, Bool)
    unsupported
                        MO_S_QuotRem {}  -> (FastString, Bool)
    unsupported
                        MO_U_QuotRem {}  -> (FastString, Bool)
    unsupported
                        MO_U_QuotRem2 {} -> (FastString, Bool)
    unsupported
                        MO_Add2 {}       -> (FastString, Bool)
    unsupported
                        MO_AddWordC {}   -> (FastString, Bool)
    unsupported
                        MO_SubWordC {}   -> (FastString, Bool)
    unsupported
                        MO_AddIntC {}    -> (FastString, Bool)
    unsupported
                        MO_SubIntC {}    -> (FastString, Bool)
    unsupported
                        MO_U_Mul2 {}     -> (FastString, Bool)
    unsupported
                        CallishMachOp
    MO_AcquireFence  -> (FastString, Bool)
    unsupported
                        CallishMachOp
    MO_ReleaseFence  -> (FastString, Bool)
    unsupported
                        CallishMachOp
    MO_SeqCstFence   -> (FastString, Bool)
    unsupported
                        CallishMachOp
    MO_Touch         -> (FastString, Bool)
    unsupported
                        MO_Prefetch_Data Int
    _ -> (FastString, Bool)
    unsupported
                    unsupported :: (FastString, Bool)
    unsupported = String -> (FastString, Bool)
    forall a. HasCallStack => String -> a
    panic (String
    "outOfLineCmmOp: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ CallishMachOp -> String
    forall a. Show a => a -> String
    show CallishMachOp
    mop
                                      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " not supported")

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

    genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM InstrBlock
    genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM (OrdList Instr)
    genSwitch NCGConfig
    config CmmExpr
    expr SwitchTargets
    targets
      | OS
    OSAIX <- Platform -> OS
    platformOS Platform
    platform
      = do
            (reg,e_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    indexExpr
            let fmt = Bool -> Format
    archWordFormat (Bool -> Format) -> Bool -> Format
    forall a b. (a -> b) -> a -> b
    $ Platform -> Bool
    target32Bit Platform
    platform
                sha = if Platform -> Bool
    target32Bit Platform
    platform then Int
    2 else Int
    3
            tmp <- getNewRegNat fmt
            lbl <- getNewLabelNat
            dynRef <- cmmMakeDynamicReference config DataReference lbl
            (tableReg,t_code) <- getSomeReg $ dynRef
            let code = 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 -> Reg -> Reg -> RI -> Instr
    SL Format
    fmt Reg
    tmp Reg
    reg (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    sha)),
                                Format -> Reg -> AddrMode -> Instr
    LD Format
    fmt Reg
    tmp (Reg -> Reg -> AddrMode
    AddrRegReg Reg
    tableReg Reg
    tmp),
                                Reg -> Instr
    MTCTR Reg
    tmp,
                                [Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
    BCTR [Maybe BlockId]
    ids (CLabel -> Maybe CLabel
    forall a. a -> Maybe a
    Just CLabel
    lbl) []
                        ]
            return code

      | (NCGConfig -> Bool
    ncgPIC NCGConfig
    config) Bool -> Bool -> Bool
    || (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Platform -> Bool
    target32Bit Platform
    platform)
      = do
            (reg,e_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    indexExpr
            let fmt = Bool -> Format
    archWordFormat (Bool -> Format) -> Bool -> Format
    forall a b. (a -> b) -> a -> b
    $ Platform -> Bool
    target32Bit Platform
    platform
                sha = if Platform -> Bool
    target32Bit Platform
    platform then Int
    2 else Int
    3
            tmp <- getNewRegNat fmt
            lbl <- getNewLabelNat
            dynRef <- cmmMakeDynamicReference config DataReference lbl
            (tableReg,t_code) <- getSomeReg $ dynRef
            let code = 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 -> Reg -> Reg -> RI -> Instr
    SL Format
    fmt Reg
    tmp Reg
    reg (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    sha)),
                                Format -> Reg -> AddrMode -> Instr
    LD Format
    fmt Reg
    tmp (Reg -> Reg -> AddrMode
    AddrRegReg Reg
    tableReg Reg
    tmp),
                                Reg -> Reg -> RI -> Instr
    ADD Reg
    tmp Reg
    tmp (Reg -> RI
    RIReg Reg
    tableReg),
                                Reg -> Instr
    MTCTR Reg
    tmp,
                                [Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
    BCTR [Maybe BlockId]
    ids (CLabel -> Maybe CLabel
    forall a. a -> Maybe a
    Just CLabel
    lbl) []
                        ]
            return code
      | Bool
    otherwise
      = do
            (reg,e_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    indexExpr
            let fmt = Bool -> Format
    archWordFormat (Bool -> Format) -> Bool -> Format
    forall a b. (a -> b) -> a -> b
    $ Platform -> Bool
    target32Bit Platform
    platform
                sha = if Platform -> Bool
    target32Bit Platform
    platform then Int
    2 else Int
    3
            tmp <- getNewRegNat fmt
            lbl <- getNewLabelNat
            let 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 -> Reg -> Reg -> RI -> Instr
    SL Format
    fmt Reg
    tmp Reg
    reg (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    sha)),
                                Reg -> Reg -> Imm -> Instr
    ADDIS Reg
    tmp Reg
    tmp (Imm -> Imm
    HA (CLabel -> Imm
    ImmCLbl CLabel
    lbl)),
                                Format -> Reg -> AddrMode -> Instr
    LD Format
    fmt Reg
    tmp (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    tmp (Imm -> Imm
    LO (CLabel -> Imm
    ImmCLbl CLabel
    lbl))),
                                Reg -> Instr
    MTCTR Reg
    tmp,
                                [Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
    BCTR [Maybe BlockId]
    ids (CLabel -> Maybe CLabel
    forall a. a -> Maybe a
    Just CLabel
    lbl) []
                        ]
            return code
      where
        -- See Note [Sub-word subtlety during jump-table indexing] in
        -- GHC.CmmToAsm.X86.CodeGen for why we must first offset, then widen.
        indexExpr0 :: CmmExpr
    indexExpr0 = Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffset Platform
    platform CmmExpr
    expr Int
    offset
        -- We widen to a native-width register to sanitize the high bits
        indexExpr :: CmmExpr
    indexExpr = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp
          (Width -> Width -> MachOp
    MO_UU_Conv Width
    expr_w (Platform -> Width
    platformWordWidth Platform
    platform))
          [CmmExpr
    indexExpr0]
        expr_w :: Width
    expr_w = Platform -> CmmExpr -> Width
    cmmExprWidth Platform
    platform CmmExpr
    expr
        (Int
    offset, [Maybe BlockId]
    ids) = SwitchTargets -> (Int, [Maybe BlockId])
    switchTargetsToTable SwitchTargets
    targets
        platform :: Platform
    platform      = NCGConfig -> Platform
    ncgPlatform NCGConfig
    config

    generateJumpTableForInstr :: NCGConfig -> Instr
                              -> Maybe (NatCmmDecl RawCmmStatics Instr)
    generateJumpTableForInstr :: NCGConfig -> Instr -> Maybe (NatCmmDecl RawCmmStatics Instr)
    generateJumpTableForInstr NCGConfig
    config (BCTR [Maybe BlockId]
    ids (Just CLabel
    lbl) [Reg]
    _) =
        let jumpTable :: [CmmStatic]
    jumpTable
                | (NCGConfig -> Bool
    ncgPIC NCGConfig
    config) Bool -> Bool -> Bool
    || (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Platform -> Bool
    target32Bit (Platform -> Bool) -> Platform -> Bool
    forall a b. (a -> b) -> a -> b
    $ NCGConfig -> Platform
    ncgPlatform NCGConfig
    config)
                = (Maybe BlockId -> CmmStatic) -> [Maybe BlockId] -> [CmmStatic]
    forall a b. (a -> b) -> [a] -> [b]
    map Maybe BlockId -> CmmStatic
    jumpTableEntryRel [Maybe BlockId]
    ids
                | Bool
    otherwise = (Maybe BlockId -> CmmStatic) -> [Maybe BlockId] -> [CmmStatic]
    forall a b. (a -> b) -> [a] -> [b]
    map (NCGConfig -> Maybe BlockId -> CmmStatic
    jumpTableEntry NCGConfig
    config) [Maybe BlockId]
    ids
                    where jumpTableEntryRel :: Maybe BlockId -> CmmStatic
    jumpTableEntryRel Maybe BlockId
    Nothing
                            = CmmLit -> CmmStatic
    CmmStaticLit (Integer -> Width -> CmmLit
    CmmInt Integer
    0 (NCGConfig -> Width
    ncgWordWidth NCGConfig
    config))
                          jumpTableEntryRel (Just BlockId
    blockid)
                            = CmmLit -> CmmStatic
    CmmStaticLit (CLabel -> CLabel -> Int -> Width -> CmmLit
    CmmLabelDiffOff CLabel
    blockLabel CLabel
    lbl Int
    0
                                             (NCGConfig -> Width
    ncgWordWidth NCGConfig
    config))
                                where blockLabel :: CLabel
    blockLabel = BlockId -> CLabel
    blockLbl BlockId
    blockid
        in NatCmmDecl RawCmmStatics Instr
    -> Maybe (NatCmmDecl RawCmmStatics Instr)
    forall a. a -> Maybe a
    Just (Section -> RawCmmStatics -> NatCmmDecl RawCmmStatics Instr
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData (SectionType -> CLabel -> Section
    Section SectionType
    ReadOnlyData CLabel
    lbl) (CLabel -> [CmmStatic] -> RawCmmStatics
    forall (rawOnly :: Bool).
    CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
    CmmStaticsRaw CLabel
    lbl [CmmStatic]
    jumpTable))
    generateJumpTableForInstr NCGConfig
    _ Instr
    _ = Maybe (NatCmmDecl RawCmmStatics Instr)
    forall a. Maybe a
    Nothing

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

    condReg :: NatM CondCode -> NatM Register
    condReg :: NatM CondCode -> NatM Register
    condReg NatM CondCode
    getCond = do
        CondCode _ cond cond_code <- NatM CondCode
    getCond
        platform <- getPlatform
        let
            code Reg
    dst = OrdList Instr
    cond_code
                OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    negate_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 [
                    Reg -> Instr
    MFCR Reg
    dst,
                    Reg -> Reg -> Int -> Int -> Int -> Instr
    RLWINM Reg
    dst Reg
    dst (Int
    bit Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Int
    31 Int
    31
                ]

            negate_code | Bool
    do_negate = Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Int -> Int -> Int -> Instr
    CRNOR Int
    bit Int
    bit Int
    bit)
                        | Bool
    otherwise = OrdList Instr
    forall a. OrdList a
    nilOL

            (bit, do_negate) = case cond of
                Cond
    LTT -> (Int
    0, Bool
    False)
                Cond
    LE  -> (Int
    1, Bool
    True)
                Cond
    EQQ -> (Int
    2, Bool
    False)
                Cond
    GE  -> (Int
    0, Bool
    True)
                Cond
    GTT -> (Int
    1, Bool
    False)

                Cond
    NE  -> (Int
    2, Bool
    True)

                Cond
    LU  -> (Int
    0, Bool
    False)
                Cond
    LEU -> (Int
    1, Bool
    True)
                Cond
    GEU -> (Int
    0, Bool
    True)
                Cond
    GU  -> (Int
    1, Bool
    False)
                Cond
    _   -> String -> (Int, Bool)
    forall a. HasCallStack => String -> a
    panic String
    "PPC.CodeGen.codeReg: no match"

            format = Bool -> Format
    archWordFormat (Bool -> Format) -> Bool -> Format
    forall a b. (a -> b) -> a -> b
    $ Platform -> Bool
    target32Bit Platform
    platform
        return (Any format code)

    condIntReg :: Cond -> Width -> CmmExpr -> CmmExpr -> NatM Register
    condIntReg :: Cond -> Width -> CmmExpr -> CmmExpr -> NatM Register
    condIntReg Cond
    cond Width
    width CmmExpr
    x CmmExpr
    y = NatM CondCode -> NatM Register
    condReg (Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode Cond
    cond Width
    width CmmExpr
    x CmmExpr
    y)
    condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg Cond
    cond CmmExpr
    x CmmExpr
    y = NatM CondCode -> NatM Register
    condReg (Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    cond CmmExpr
    x CmmExpr
    y)

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

    {-
    Wolfgang's PowerPC version of The Rules:

    A slightly modified version of The Rules to take advantage of the fact
    that PowerPC instructions work on all registers and don't implicitly
    clobber any fixed registers.

    * The only expression for which getRegister returns Fixed is (CmmReg reg).

    * If getRegister returns Any, then the code it generates may modify only:
            (a) fresh temporaries
            (b) the destination register
      It may *not* modify global registers, unless the global
      register happens to be the destination register.
      It may not clobber any other registers. In fact, only ccalls clobber any
      fixed registers.
      Also, it may not modify the counter register (used by genCCall).

      Corollary: If a getRegister for a subexpression returns Fixed, you need
      not move it to a fresh temporary before evaluating the next subexpression.
      The Fixed register won't be modified.
      Therefore, we don't need a counterpart for the x86's getStableReg on PPC.

    * SDM's First Rule is valid for PowerPC, too: subexpressions can depend on
      the value of the destination register.
    -}

    trivialCode
            :: Width
            -> Bool
            -> (Reg -> Reg -> RI -> Instr)
            -> CmmExpr
            -> CmmExpr
            -> NatM Register

    trivialCode :: Width
    -> Bool
    -> (Reg -> Reg -> RI -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    rep Bool
    signed Reg -> Reg -> RI -> Instr
    instr CmmExpr
    x (CmmLit (CmmInt Integer
    y Width
    _))
        | Just Imm
    imm <- Width -> Bool -> Integer -> Maybe Imm
    forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    rep Bool
    signed Integer
    y
        = do
            (src1, code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
            let code Reg
    dst = OrdList Instr
    code1 OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> RI -> Instr
    instr Reg
    dst Reg
    src1 (Imm -> RI
    RIImm Imm
    imm)
            return (Any (intFormat rep) code)

    trivialCode Width
    rep Bool
    _ Reg -> Reg -> RI -> Instr
    instr CmmExpr
    x CmmExpr
    y = do
        (src1, code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
        (src2, code2) <- getSomeReg y
        let code Reg
    dst = OrdList Instr
    code1 OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code2 OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> RI -> Instr
    instr Reg
    dst Reg
    src1 (Reg -> RI
    RIReg Reg
    src2)
        return (Any (intFormat rep) code)

    shiftMulCode
            :: Width
            -> Bool
            -> (Format-> Reg -> Reg -> RI -> Instr)
            -> CmmExpr
            -> CmmExpr
            -> NatM Register
    shiftMulCode :: Width
    -> Bool
    -> (Format -> Reg -> Reg -> RI -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    shiftMulCode Width
    width Bool
    sign Format -> Reg -> Reg -> RI -> Instr
    instr CmmExpr
    x (CmmLit (CmmInt Integer
    y Width
    _))
        | Just Imm
    imm <- Width -> Bool -> Integer -> Maybe Imm
    forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    width Bool
    sign Integer
    y
        = do
            (src1, code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
            let format = Width -> Format
    intFormat Width
    width
            let ins_fmt = Width -> Format
    intFormat (Width -> Width -> Width
    forall a. Ord a => a -> a -> a
    max Width
    W32 Width
    width)
            let code Reg
    dst = OrdList Instr
    code1 OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> Reg -> RI -> Instr
    instr Format
    ins_fmt Reg
    dst Reg
    src1 (Imm -> RI
    RIImm Imm
    imm)
            return (Any format code)

    shiftMulCode Width
    width Bool
    _ Format -> Reg -> Reg -> RI -> Instr
    instr CmmExpr
    x CmmExpr
    y = do
        (src1, code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
        (src2, code2) <- getSomeReg y
        let format = Width -> Format
    intFormat Width
    width
        let ins_fmt = Width -> Format
    intFormat (Width -> Width -> Width
    forall a. Ord a => a -> a -> a
    max Width
    W32 Width
    width)
        let code Reg
    dst = OrdList Instr
    code1 OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code2
                       OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> Reg -> RI -> Instr
    instr Format
    ins_fmt Reg
    dst Reg
    src1 (Reg -> RI
    RIReg Reg
    src2)
        return (Any format code)

    trivialCodeNoImm' :: Format -> (Reg -> Reg -> Reg -> Instr)
                     -> CmmExpr -> CmmExpr -> NatM Register
    trivialCodeNoImm' :: Format
    -> (Reg -> Reg -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCodeNoImm' Format
    format Reg -> Reg -> Reg -> Instr
    instr CmmExpr
    x CmmExpr
    y = do
        (src1, code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
        (src2, code2) <- getSomeReg y
        let code Reg
    dst = OrdList Instr
    code1 OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code2 OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Reg -> Instr
    instr Reg
    dst Reg
    src1 Reg
    src2
        return (Any format code)

    trivialCodeNoImm :: Format -> (Format -> Reg -> Reg -> Reg -> Instr)
                     -> CmmExpr -> CmmExpr -> NatM Register
    trivialCodeNoImm :: Format
    -> (Format -> Reg -> Reg -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCodeNoImm Format
    format Format -> Reg -> Reg -> Reg -> Instr
    instr CmmExpr
    x CmmExpr
    y
      = Format
    -> (Reg -> Reg -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCodeNoImm' Format
    format (Format -> Reg -> Reg -> Reg -> Instr
    instr Format
    format) CmmExpr
    x CmmExpr
    y

    srCode :: Width -> Bool -> (Format-> Reg -> Reg -> RI -> Instr)
           -> CmmExpr -> CmmExpr -> NatM Register
    srCode :: Width
    -> Bool
    -> (Format -> Reg -> Reg -> RI -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    srCode Width
    width Bool
    sgn Format -> Reg -> Reg -> RI -> Instr
    instr CmmExpr
    x (CmmLit (CmmInt Integer
    y Width
    _))
        | Just Imm
    imm <- Width -> Bool -> Integer -> Maybe Imm
    forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    width Bool
    sgn Integer
    y
        = do
            let op_len :: Width
    op_len = Width -> Width -> Width
    forall a. Ord a => a -> a -> a
    max Width
    W32 Width
    width
                extend :: Width -> Width -> CmmExpr -> CmmExpr
    extend = if Bool
    sgn then Width -> Width -> CmmExpr -> CmmExpr
    extendSExpr else Width -> Width -> CmmExpr -> CmmExpr
    extendUExpr
            (src1, code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
    extend Width
    width Width
    op_len CmmExpr
    x)
            let code Reg
    dst = OrdList Instr
    code1 OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                           Format -> Reg -> Reg -> RI -> Instr
    instr (Width -> Format
    intFormat Width
    op_len) Reg
    dst Reg
    src1 (Imm -> RI
    RIImm Imm
    imm)
            return (Any (intFormat width) code)

    srCode Width
    width Bool
    sgn Format -> Reg -> Reg -> RI -> Instr
    instr CmmExpr
    x CmmExpr
    y = do
      let op_len :: Width
    op_len = Width -> Width -> Width
    forall a. Ord a => a -> a -> a
    max Width
    W32 Width
    width
          extend :: Width -> Width -> CmmExpr -> CmmExpr
    extend = if Bool
    sgn then Width -> Width -> CmmExpr -> CmmExpr
    extendSExpr else Width -> Width -> CmmExpr -> CmmExpr
    extendUExpr
      (src1, code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
    extend Width
    width Width
    op_len CmmExpr
    x)
      (src2, code2) <- getSomeReg (extendUExpr width op_len y)
      -- Note: Shift amount `y` is unsigned
      let code Reg
    dst = OrdList Instr
    code1 OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code2 OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                     Format -> Reg -> Reg -> RI -> Instr
    instr (Width -> Format
    intFormat Width
    op_len) Reg
    dst Reg
    src1 (Reg -> RI
    RIReg Reg
    src2)
      return (Any (intFormat width) code)

    divCode :: Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    divCode :: Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    divCode Width
    width Bool
    sgn CmmExpr
    x CmmExpr
    y = do
      let op_len :: Width
    op_len = Width -> Width -> Width
    forall a. Ord a => a -> a -> a
    max Width
    W32 Width
    width
          extend :: Width -> Width -> CmmExpr -> CmmExpr
    extend = if Bool
    sgn then Width -> Width -> CmmExpr -> CmmExpr
    extendSExpr else Width -> Width -> CmmExpr -> CmmExpr
    extendUExpr
      (src1, code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
    extend Width
    width Width
    op_len CmmExpr
    x)
      (src2, code2) <- getSomeReg (extend width op_len y)
      let code Reg
    dst = OrdList Instr
    code1 OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code2 OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                     Format -> Bool -> Reg -> Reg -> Reg -> Instr
    DIV (Width -> Format
    intFormat Width
    op_len) Bool
    sgn Reg
    dst Reg
    src1 Reg
    src2
      return (Any (intFormat width) code)

    trivialUCode :: Format
                 -> (Reg -> Reg -> Instr)
                 -> CmmExpr
                 -> NatM Register
    trivialUCode :: Format -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register
    trivialUCode Format
    rep Reg -> Reg -> Instr
    instr CmmExpr
    x = do
        (src, code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
        let code' Reg
    dst = OrdList Instr
    code OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Instr
    instr Reg
    dst Reg
    src
        return (Any rep code')

    -- | Generate code for a 4-register FMA instruction,
    -- e.g. @fmadd rt ra rc rb := rt <- ra * rc + rb@.
    fma_code :: Width
             -> (Format -> Reg -> Reg -> Reg -> Reg -> Instr)
             -> CmmExpr
             -> CmmExpr
             -> CmmExpr
             -> NatM Register
    fma_code :: Width
    -> (Format -> Reg -> Reg -> Reg -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    fma_code Width
    w Format -> Reg -> Reg -> Reg -> Reg -> Instr
    instr CmmExpr
    ra CmmExpr
    rc CmmExpr
    rb = do
        let rep :: Format
    rep = Width -> Format
    floatFormat Width
    w
        (src1, code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    ra
        (src2, code2) <- getSomeReg rc
        (src3, code3) <- getSomeReg rb
        let instrCode Reg
    rt =
              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
    code3 OrdList Instr -> Instr -> OrdList Instr
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> Reg -> Reg -> Reg -> Instr
    instr Format
    rep Reg
    rt Reg
    src1 Reg
    src2 Reg
    src3
        return $ Any rep instrCode

    -- There is no "remainder" instruction on the PPC, so we have to do
    -- it the hard way.
    -- The "sgn" parameter is the signedness for the division instruction
    remainderCode :: Width -> Bool -> Reg -> CmmExpr -> CmmExpr
                   -> NatM (Reg -> InstrBlock)
    remainderCode :: Width
    -> Bool -> Reg -> CmmExpr -> CmmExpr -> NatM (Reg -> OrdList Instr)
    remainderCode Width
    rep Bool
    sgn Reg
    reg_q CmmExpr
    arg_x CmmExpr
    arg_y = do
      let op_len :: Width
    op_len = Width -> Width -> Width
    forall a. Ord a => a -> a -> a
    max Width
    W32 Width
    rep
          fmt :: Format
    fmt    = Width -> Format
    intFormat Width
    op_len
          extend :: Width -> Width -> CmmExpr -> CmmExpr
    extend = if Bool
    sgn then Width -> Width -> CmmExpr -> CmmExpr
    extendSExpr else Width -> Width -> CmmExpr -> CmmExpr
    extendUExpr
      (x_reg, x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
    extend Width
    rep Width
    op_len CmmExpr
    arg_x)
      (y_reg, y_code) <- getSomeReg (extend rep op_len arg_y)
      return $ \Reg
    reg_r -> 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 -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Format -> Bool -> Reg -> Reg -> Reg -> Instr
    DIV Format
    fmt Bool
    sgn Reg
    reg_q Reg
    x_reg Reg
    y_reg
                                      , Format -> Reg -> Reg -> RI -> Instr
    MULL Format
    fmt Reg
    reg_r Reg
    reg_q (Reg -> RI
    RIReg Reg
    y_reg)
                                      , Reg -> Reg -> Reg -> Instr
    SUBF Reg
    reg_r Reg
    reg_r Reg
    x_reg
                                      ]

    coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
    coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
    coerceInt2FP Width
    fromRep Width
    toRep CmmExpr
    x = do
        platform <- NatM Platform
    getPlatform
        let arch = Platform -> Arch
    platformArch Platform
    platform
        coerceInt2FP' arch fromRep toRep x

    coerceInt2FP' :: Arch -> Width -> Width -> CmmExpr -> NatM Register
    coerceInt2FP' :: Arch -> Width -> Width -> CmmExpr -> NatM Register
    coerceInt2FP' Arch
    ArchPPC Width
    fromRep Width
    toRep CmmExpr
    x = do
        (src, code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
        lbl <- getNewLabelNat
        itmp <- getNewRegNat II32
        ftmp <- getNewRegNat FF64
        config <- getConfig
        platform <- getPlatform
        dynRef <- cmmMakeDynamicReference config DataReference lbl
        Amode addr addr_code <- getAmode D dynRef
        let
            code' Reg
    dst = OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    maybe_exts OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                    Section -> RawCmmStatics -> Instr
    LDATA (SectionType -> CLabel -> Section
    Section SectionType
    ReadOnlyData CLabel
    lbl) (RawCmmStatics -> Instr) -> RawCmmStatics -> Instr
    forall a b. (a -> b) -> a -> b
    $ CLabel -> [CmmStatic] -> RawCmmStatics
    forall (rawOnly :: Bool).
    CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
    CmmStaticsRaw CLabel
    lbl
                                     [CmmLit -> CmmStatic
    CmmStaticLit (Integer -> Width -> CmmLit
    CmmInt Integer
    0x43300000 Width
    W32),
                                      CmmLit -> CmmStatic
    CmmStaticLit (Integer -> Width -> CmmLit
    CmmInt Integer
    0x80000000 Width
    W32)],
                    Reg -> Reg -> Imm -> Instr
    XORIS Reg
    itmp Reg
    src (Int -> Imm
    ImmInt Int
    0x8000),
                    Format -> Reg -> AddrMode -> Instr
    ST Format
    II32 Reg
    itmp (Platform -> Int -> AddrMode
    spRel Platform
    platform Int
    3),
                    Reg -> Imm -> Instr
    LIS Reg
    itmp (Int -> Imm
    ImmInt Int
    0x4330),
                    Format -> Reg -> AddrMode -> Instr
    ST Format
    II32 Reg
    itmp (Platform -> Int -> AddrMode
    spRel Platform
    platform Int
    2),
                    Format -> Reg -> AddrMode -> Instr
    LD Format
    FF64 Reg
    ftmp (Platform -> Int -> AddrMode
    spRel Platform
    platform Int
    2)
                ] OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    addr_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 -> Reg -> AddrMode -> Instr
    LD Format
    FF64 Reg
    dst AddrMode
    addr,
                    Format -> Reg -> Reg -> Reg -> Instr
    FSUB Format
    FF64 Reg
    dst Reg
    ftmp Reg
    dst
                ] OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> OrdList Instr
    maybe_frsp Reg
    dst

            maybe_exts = case Width
    fromRep of
                            Width
    W8 ->  Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> Reg -> Instr
    EXTS Format
    II8 Reg
    src Reg
    src
                            Width
    W16 -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> Reg -> Instr
    EXTS Format
    II16 Reg
    src Reg
    src
                            Width
    W32 -> OrdList Instr
    forall a. OrdList a
    nilOL
                            Width
    _       -> String -> OrdList Instr
    forall a. HasCallStack => String -> a
    panic String
    "PPC.CodeGen.coerceInt2FP: no match"

            maybe_frsp Reg
    dst
                    = case Width
    toRep of
                            Width
    W32 -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Reg -> Reg -> Instr
    FRSP Reg
    dst Reg
    dst
                            Width
    W64 -> OrdList Instr
    forall a. OrdList a
    nilOL
                            Width
    _       -> String -> OrdList Instr
    forall a. HasCallStack => String -> a
    panic String
    "PPC.CodeGen.coerceInt2FP: no match"

        return (Any (floatFormat toRep) code')

    -- On an ELF v1 Linux we use the compiler doubleword in the stack frame
    -- this is the TOC pointer doubleword on ELF v2 Linux. The latter is only
    -- set right before a call and restored right after return from the call.
    -- So it is fine.
    coerceInt2FP' (ArchPPC_64 PPC_64ABI
    _) Width
    fromRep Width
    toRep CmmExpr
    x = do
        (src, code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
        platform <- getPlatform
        upper <- getNewRegNat II64
        lower <- getNewRegNat II64
        l1 <- getBlockIdNat
        l2 <- getBlockIdNat
        let
            code' Reg
    dst = OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    maybe_exts 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 -> Reg -> AddrMode -> Instr
    ST Format
    II64 Reg
    src (Platform -> Int -> AddrMode
    spRel Platform
    platform Int
    3),
                    Format -> Reg -> AddrMode -> Instr
    LD Format
    FF64 Reg
    dst (Platform -> Int -> AddrMode
    spRel Platform
    platform Int
    3),
                    Reg -> Reg -> Instr
    FCFID Reg
    dst Reg
    dst
                ] OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> OrdList Instr
    maybe_frsp Reg
    dst

            maybe_exts
              = case Width
    fromRep of
                  Width
    W8 ->  Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> Reg -> Instr
    EXTS Format
    II8 Reg
    src Reg
    src
                  Width
    W16 -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> Reg -> Instr
    EXTS Format
    II16 Reg
    src Reg
    src
                  Width
    W32 -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> Reg -> Instr
    EXTS Format
    II32 Reg
    src Reg
    src
                  Width
    W64 -> case Width
    toRep of
                            Width
    W32 -> [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [ Format -> Reg -> Reg -> RI -> Instr
    SRA Format
    II64 Reg
    upper Reg
    src (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    53))
                                        , Format -> Reg -> Reg -> Int -> Instr
    CLRLI Format
    II64 Reg
    lower Reg
    src Int
    53
                                        , Reg -> Reg -> RI -> Instr
    ADD Reg
    upper Reg
    upper (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    1))
                                        , Reg -> Reg -> RI -> Instr
    ADD Reg
    lower Reg
    lower (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    2047))
                                        , Format -> Reg -> RI -> Instr
    CMPL Format
    II64 Reg
    upper (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    2))
                                        , Reg -> Reg -> RI -> Instr
    OR Reg
    lower Reg
    lower (Reg -> RI
    RIReg Reg
    src)
                                        , Format -> Reg -> Reg -> Int -> Instr
    CLRRI Format
    II64 Reg
    lower Reg
    lower Int
    11
                                        , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    LTT BlockId
    l2 Maybe Bool
    forall a. Maybe a
    Nothing
                                        , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    l1 Maybe Bool
    forall a. Maybe a
    Nothing
                                        , BlockId -> Instr
    NEWBLOCK BlockId
    l1
                                        , Reg -> Reg -> Instr
    MR Reg
    src Reg
    lower
                                        , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    l2 Maybe Bool
    forall a. Maybe a
    Nothing
                                        , BlockId -> Instr
    NEWBLOCK BlockId
    l2
                                        ]
                            Width
    _   -> OrdList Instr
    forall a. OrdList a
    nilOL
                  Width
    _       -> String -> OrdList Instr
    forall a. HasCallStack => String -> a
    panic String
    "PPC.CodeGen.coerceInt2FP: no match"

            maybe_frsp Reg
    dst
                    = case Width
    toRep of
                            Width
    W32 -> Instr -> OrdList Instr
    forall a. a -> OrdList a
    unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
    forall a b. (a -> b) -> a -> b
    $ Reg -> Reg -> Instr
    FRSP Reg
    dst Reg
    dst
                            Width
    W64 -> OrdList Instr
    forall a. OrdList a
    nilOL
                            Width
    _       -> String -> OrdList Instr
    forall a. HasCallStack => String -> a
    panic String
    "PPC.CodeGen.coerceInt2FP: no match"

        return (Any (floatFormat toRep) code')

    coerceInt2FP' Arch
    _ Width
    _ Width
    _ CmmExpr
    _ = String -> NatM Register
    forall a. HasCallStack => String -> a
    panic String
    "PPC.CodeGen.coerceInt2FP: unknown arch"

    coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
    coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
    coerceFP2Int Width
    fromRep Width
    toRep CmmExpr
    x = do
        platform <- NatM Platform
    getPlatform
        let arch =  Platform -> Arch
    platformArch Platform
    platform
        coerceFP2Int' arch fromRep toRep x

    coerceFP2Int' :: Arch -> Width -> Width -> CmmExpr -> NatM Register
    coerceFP2Int' :: Arch -> Width -> Width -> CmmExpr -> NatM Register
    coerceFP2Int' Arch
    ArchPPC Width
    _ Width
    toRep CmmExpr
    x = do
        platform <- NatM Platform
    getPlatform
        -- the reps don't really matter: F*->FF64 and II32->I* are no-ops
        (src, code) <- getSomeReg x
        tmp <- getNewRegNat FF64
        let
            code' Reg
    dst = OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                    -- convert to int in FP reg
                Reg -> Reg -> Instr
    FCTIWZ Reg
    tmp Reg
    src,
                    -- store value (64bit) from FP to stack
                Format -> Reg -> AddrMode -> Instr
    ST Format
    FF64 Reg
    tmp (Platform -> Int -> AddrMode
    spRel Platform
    platform Int
    2),
                    -- read low word of value (high word is undefined)
                Format -> Reg -> AddrMode -> Instr
    LD Format
    II32 Reg
    dst (Platform -> Int -> AddrMode
    spRel Platform
    platform Int
    3)]
        return (Any (intFormat toRep) code')

    coerceFP2Int' (ArchPPC_64 PPC_64ABI
    _) Width
    _ Width
    toRep CmmExpr
    x = do
        platform <- NatM Platform
    getPlatform
        -- the reps don't really matter: F*->FF64 and II64->I* are no-ops
        (src, code) <- getSomeReg x
        tmp <- getNewRegNat FF64
        let
            code' Reg
    dst = OrdList Instr
    code OrdList Instr -> OrdList Instr -> OrdList Instr
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> OrdList Instr
    forall a. [a] -> OrdList a
    toOL [
                    -- convert to int in FP reg
                Reg -> Reg -> Instr
    FCTIDZ Reg
    tmp Reg
    src,
                    -- store value (64bit) from FP to compiler word on stack
                Format -> Reg -> AddrMode -> Instr
    ST Format
    FF64 Reg
    tmp (Platform -> Int -> AddrMode
    spRel Platform
    platform Int
    3),
                Format -> Reg -> AddrMode -> Instr
    LD Format
    II64 Reg
    dst (Platform -> Int -> AddrMode
    spRel Platform
    platform Int
    3)]
        return (Any (intFormat toRep) code')

    coerceFP2Int' Arch
    _ Width
    _ Width
    _ CmmExpr
    _ = String -> NatM Register
    forall a. HasCallStack => String -> a
    panic String
    "PPC.CodeGen.coerceFP2Int: unknown arch"

    -- Note [.LCTOC1 in PPC PIC code]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- The .LCTOC1 label is defined to point 32768 bytes into the GOT table
    -- to make the most of the PPC's 16-bit displacements.
    -- As 16-bit signed offset is used (usually via addi/lwz instructions)
    -- first element will have '-32768' offset against .LCTOC1.

    -- Note [implicit register in PPC PIC code]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- PPC generates calls by labels in assembly
    -- in form of:
    --     bl puts+32768@plt
    -- in this form it's not seen directly (by GHC NCG)
    -- that r30 (PicBaseReg) is used,
    -- but r30 is a required part of PLT code setup:
    --   puts+32768@plt:
    --       lwz     r11,-30484(r30) ; offset in .LCTOC1
    --       mtctr   r11
    --       bctr