    {-# LANGUAGE CPP #-}
    {-# 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

    #include "HsVersions.h"

    -- 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, getNewRegPairNat
       , 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.Ppr           ( pprExpr )
    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
    import GHC.Utils.Misc

    -- -----------------------------------------------------------------------------
    -- 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
      ([[NatBasicBlock Instr]]
    nat_blocks,[[NatCmmDecl RawCmmStatics Instr]]
    statics) <- 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
    platform <- NatM Platform
    getPlatform
      let proc :: NatCmmDecl RawCmmStatics Instr
    proc = forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc LabelMap RawCmmStatics
    info CLabel
    lab [GlobalReg]
    live (forall i. [GenBasicBlock i] -> ListGraph i
    ListGraph forall a b. (a -> b) -> a -> b
    $ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[NatBasicBlock Instr]]
    nat_blocks)
          tops :: [NatCmmDecl RawCmmStatics Instr]
    tops = NatCmmDecl RawCmmStatics Instr
    proc forall a. a -> [a] -> [a]
    : forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[NatCmmDecl RawCmmStatics Instr]]
    statics
          os :: OS
    os   = Platform -> OS
    platformOS Platform
    platform
          arch :: Arch
    arch = Platform -> Arch
    platformArch Platform
    platform
      case Arch
    arch of
        Arch
    ArchPPC | OS
    os forall a. Eq a => a -> a -> Bool
    == OS
    OSAIX -> forall (m :: * -> *) a. Monad m => a -> m a
    return [NatCmmDecl RawCmmStatics Instr]
    tops
                | Bool
    otherwise -> do
          Maybe Reg
    picBaseMb <- NatM (Maybe Reg)
    getPicBaseMaybeNat
          case Maybe Reg
    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 -> forall (m :: * -> *) a. Monad m => a -> m a
    return [NatCmmDecl RawCmmStatics Instr]
    tops
        ArchPPC_64 PPC_64ABI
    ELF_V1 -> 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 -> 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
    _          -> forall a. 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
            BlockId
    bID' <- if CLabel
    lab forall a. Eq a => a -> a -> Bool
    == (BlockId -> CLabel
    blockLbl BlockId
    bID)
                    then forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
                    else forall (m :: * -> *) a. Monad m => a -> m a
    return BlockId
    bID
            let b' :: GenBasicBlock i
    b' = forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    bID' [i]
    insns
            forall (m :: * -> *) a. Monad m => a -> m a
    return (forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc h
    info CLabel
    lab [GlobalReg]
    live (forall i. [GenBasicBlock i] -> ListGraph i
    ListGraph (GenBasicBlock i
    b'forall a. a -> [a] -> [a]
    :[GenBasicBlock i]
    blocks)) forall a. a -> [a] -> [a]
    : [GenCmmDecl d h (ListGraph i)]
    statics)
          fixup_entry [GenCmmDecl d h (ListGraph i)]
    _ = forall a. String -> a
    panic String
    "cmmTopCodegen: Broken CmmProc"

    cmmTopCodeGen (CmmData Section
    sec RawCmmStatics
    dat) =
      forall (m :: * -> *) a. Monad m => a -> m a
    return [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)  = forall (n :: Extensibility -> Extensibility -> *).
    Block n C C -> (n C O, Block n O O, n O C)
    blockSplit CmmBlock
    block
          id :: BlockId
    id = forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> BlockId
    entryLabel CmmBlock
    block
          stmts :: [CmmNode O O]
    stmts = forall (n :: Extensibility -> Extensibility -> *).
    Block n O O -> [n O O]
    blockToList Block CmmNode O O
    nodes
      -- Generate location directive
      Maybe DebugBlock
    dbg <- BlockId -> NatM (Maybe DebugBlock)
    getDebugBlock (forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> BlockId
    entryLabel CmmBlock
    block)
      OrdList Instr
    loc_instrs <- case DebugBlock -> Maybe CmmTickish
    dblSourceTick forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Maybe DebugBlock
    dbg of
        Just (SourceNote RealSrcSpan
    span String
    name)
          -> do Int
    fileid <- FastString -> NatM Int
    getFileId (RealSrcSpan -> FastString
    srcSpanFile RealSrcSpan
    span)
                let line :: Int
    line = RealSrcSpan -> Int
    srcSpanStartLine RealSrcSpan
    span; col :: Int
    col =RealSrcSpan -> Int
    srcSpanStartCol RealSrcSpan
    span
                forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ forall a. a -> OrdList a
    unitOL forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int -> String -> Instr
    LOCATION Int
    fileid Int
    line Int
    col String
    name
        Maybe CmmTickish
    _ -> forall (m :: * -> *) a. Monad m => a -> m a
    return forall a. OrdList a
    nilOL
      OrdList Instr
    mid_instrs <- forall (e :: Extensibility) (x :: Extensibility).
    [CmmNode e x] -> NatM (OrdList Instr)
    stmtsToInstrs [CmmNode O O]
    stmts
      OrdList Instr
    tail_instrs <- forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> NatM (OrdList Instr)
    stmtToInstrs CmmNode O C
    tail
      let instrs :: OrdList Instr
    instrs = OrdList Instr
    loc_instrs forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    mid_instrs 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
            ([Instr]
    top,[NatBasicBlock Instr]
    other_blocks,[NatCmmDecl RawCmmStatics Instr]
    statics) = forall a b. (a -> b -> b) -> b -> OrdList a -> b
    foldrOL forall {h} {g}.
    Instr
    -> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
    -> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
    mkBlocks ([],[],[]) OrdList Instr
    instrs

            mkBlocks :: Instr
    -> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
    -> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
    mkBlocks (NEWBLOCK BlockId
    id) ([Instr]
    instrs,[NatBasicBlock Instr]
    blocks,[GenCmmDecl RawCmmStatics h g]
    statics)
              = ([], forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    id [Instr]
    instrs 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, forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData Section
    sec RawCmmStatics
    datforall a. a -> [a] -> [a]
    :[GenCmmDecl RawCmmStatics h g]
    statics)
            mkBlocks Instr
    instr ([Instr]
    instrs,[NatBasicBlock Instr]
    blocks,[GenCmmDecl RawCmmStatics h g]
    statics)
              = (Instr
    instrforall a. a -> [a] -> [a]
    :[Instr]
    instrs, [NatBasicBlock Instr]
    blocks, [GenCmmDecl RawCmmStatics h g]
    statics)
      forall (m :: * -> *) a. Monad m => a -> m a
    return (forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    id [Instr]
    top forall a. a -> [a] -> [a]
    : [NatBasicBlock Instr]
    other_blocks, [NatCmmDecl RawCmmStatics Instr]
    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 [OrdList Instr]
    instrss <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> NatM (OrdList Instr)
    stmtToInstrs [CmmNode e x]
    stmts
            forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. [OrdList a] -> OrdList a
    concatOL [OrdList Instr]
    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
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      Platform
    platform <- NatM Platform
    getPlatform
      case CmmNode e x
    stmt of
        CmmComment FastString
    s   -> forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. a -> OrdList a
    unitOL (FastString -> Instr
    COMMENT FastString
    s))
        CmmTick {}     -> forall (m :: * -> *) a. Monad m => a -> m a
    return forall a. OrdList a
    nilOL
        CmmUnwind {}   -> forall (m :: * -> *) a. Monad m => a -> m a
    return 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 = Platform -> CmmReg -> CmmType
    cmmRegType Platform
    platform CmmReg
    reg
                  format :: Format
    format = CmmType -> Format
    cmmTypeFormat CmmType
    ty

        CmmStore CmmExpr
    addr CmmExpr
    src AlignmentSpec
    _alignment
          | CmmType -> Bool
    isFloatType CmmType
    ty -> Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_FltCode Format
    format CmmExpr
    addr CmmExpr
    src
          | 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
          OrdList Instr
    b1 <- BlockId -> CmmExpr -> Maybe Bool -> NatM (OrdList Instr)
    genCondJump BlockId
    true CmmExpr
    arg Maybe Bool
    prediction
          OrdList Instr
    b2 <- BlockId -> NatM (OrdList Instr)
    genBranch BlockId
    false
          forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    b1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    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
    _ ->
          forall a. String -> a
    panic String
    "stmtToInstrs: statement should have been cps'd away"

    jumpRegs :: Platform -> [GlobalReg] -> [Reg]
    jumpRegs :: Platform -> [GlobalReg] -> [Reg]
    jumpRegs Platform
    platform [GlobalReg]
    gregs = [ RealReg -> Reg
    RegReal RealReg
    r | Just RealReg
    r <- 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

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

    getRegisterReg :: Platform -> CmmReg -> Reg
    getRegisterReg Platform
    _ (CmmLocal (LocalReg Unique
    u CmmType
    pk))
      = VirtualReg -> Reg
    RegVirtual forall a b. (a -> b) -> a -> b
    $ Unique -> Format -> VirtualReg
    mkVirtualReg Unique
    u (CmmType -> Format
    cmmTypeFormat CmmType
    pk)

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

    -- | 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 :: Platform -> CmmExpr -> CmmExpr
    mangleIndexTree :: Platform -> CmmExpr -> CmmExpr
    mangleIndexTree Platform
    platform (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 (forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    off) Width
    width)]
      where width :: Width
    width = CmmType -> Width
    typeWidth (Platform -> CmmReg -> CmmType
    cmmRegType Platform
    platform CmmReg
    reg)

    mangleIndexTree Platform
    _ CmmExpr
    _
            = forall a. 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.
    -}

    data ChildCode64        -- a.k.a "Register64"
          = ChildCode64
               InstrBlock   -- code
               Reg          -- the lower 32-bit temporary which contains the
                            -- result; use getHiVRegFromLo to find the other
                            -- VRegUnique.  Rules of this simplified insn
                            -- selection game are therefore that the returned
                            -- Reg may be modified

    -- | Compute an expression into a register, but
    --      we don't mind which one it is.
    getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg :: CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    expr = do
      Register
    r <- CmmExpr -> NatM Register
    getRegister CmmExpr
    expr
      case Register
    r of
        Any Format
    rep Reg -> OrdList Instr
    code -> do
            Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    rep
            forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    tmp, Reg -> OrdList Instr
    code Reg
    tmp)
        Fixed Format
    _ Reg
    reg OrdList Instr
    code ->
            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 AddrMode
    hi_addr OrdList Instr
    addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    addrTree
        case AddrMode -> Int -> Maybe AddrMode
    addrOffset AddrMode
    hi_addr Int
    4 of
            Just AddrMode
    lo_addr -> forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode
    hi_addr, AddrMode
    lo_addr, OrdList Instr
    addr_code)
            Maybe AddrMode
    Nothing      -> do (Reg
    hi_ptr, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    addrTree
                               forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    hi_ptr (Int -> Imm
    ImmInt Int
    0),
                                       Reg -> Imm -> AddrMode
    AddrRegImm Reg
    hi_ptr (Int -> Imm
    ImmInt Int
    4),
                                       OrdList Instr
    code)

    assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
    assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_I64Code CmmExpr
    addrTree CmmExpr
    valueTree = do
            (AddrMode
    hi_addr, AddrMode
    lo_addr, OrdList Instr
    addr_code) <- CmmExpr -> NatM (AddrMode, AddrMode, OrdList Instr)
    getI64Amodes CmmExpr
    addrTree
            ChildCode64 OrdList Instr
    vcode Reg
    rlo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    valueTree
            let
                    rhi :: Reg
    rhi = Reg -> Reg
    getHiVRegFromLo Reg
    rlo

                    -- Big-endian store
                    mov_hi :: Instr
    mov_hi = Format -> Reg -> AddrMode -> Instr
    ST Format
    II32 Reg
    rhi AddrMode
    hi_addr
                    mov_lo :: Instr
    mov_lo = Format -> Reg -> AddrMode -> Instr
    ST Format
    II32 Reg
    rlo AddrMode
    lo_addr
            forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    vcode forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    addr_code forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_lo forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_hi)

    assignReg_I64Code :: CmmReg  -> CmmExpr -> NatM InstrBlock
    assignReg_I64Code :: CmmReg -> CmmExpr -> NatM (OrdList Instr)
    assignReg_I64Code (CmmLocal (LocalReg Unique
    u_dst CmmType
    _)) CmmExpr
    valueTree = do
       ChildCode64 OrdList Instr
    vcode Reg
    r_src_lo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    valueTree
       let
             r_dst_lo :: Reg
    r_dst_lo = VirtualReg -> Reg
    RegVirtual forall a b. (a -> b) -> a -> b
    $ Unique -> Format -> VirtualReg
    mkVirtualReg Unique
    u_dst Format
    II32
             r_dst_hi :: Reg
    r_dst_hi = Reg -> Reg
    getHiVRegFromLo Reg
    r_dst_lo
             r_src_hi :: Reg
    r_src_hi = Reg -> Reg
    getHiVRegFromLo Reg
    r_src_lo
             mov_lo :: Instr
    mov_lo = Reg -> Reg -> Instr
    MR Reg
    r_dst_lo Reg
    r_src_lo
             mov_hi :: Instr
    mov_hi = Reg -> Reg -> Instr
    MR Reg
    r_dst_hi Reg
    r_src_hi
       forall (m :: * -> *) a. Monad m => a -> m a
    return (
            OrdList Instr
    vcode forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_lo forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_hi
         )

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

    iselExpr64        :: CmmExpr -> NatM ChildCode64
    iselExpr64 :: CmmExpr -> NatM ChildCode64
    iselExpr64 (CmmLoad CmmExpr
    addrTree CmmType
    ty AlignmentSpec
    _) | CmmType -> Bool
    isWord64 CmmType
    ty = do
        (AddrMode
    hi_addr, AddrMode
    lo_addr, OrdList Instr
    addr_code) <- CmmExpr -> NatM (AddrMode, AddrMode, OrdList Instr)
    getI64Amodes CmmExpr
    addrTree
        (Reg
    rlo, Reg
    rhi) <- Format -> NatM (Reg, Reg)
    getNewRegPairNat Format
    II32
        let mov_hi :: Instr
    mov_hi = Format -> Reg -> AddrMode -> Instr
    LD Format
    II32 Reg
    rhi AddrMode
    hi_addr
            mov_lo :: Instr
    mov_lo = Format -> Reg -> AddrMode -> Instr
    LD Format
    II32 Reg
    rlo AddrMode
    lo_addr
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ OrdList Instr -> Reg -> ChildCode64
    ChildCode64 (OrdList Instr
    addr_code forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_lo forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_hi)
                             Reg
    rlo

    iselExpr64 (CmmReg (CmmLocal (LocalReg Unique
    vu CmmType
    ty))) | CmmType -> Bool
    isWord64 CmmType
    ty
       = forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> Reg -> ChildCode64
    ChildCode64 forall a. OrdList a
    nilOL (VirtualReg -> Reg
    RegVirtual forall a b. (a -> b) -> a -> b
    $ Unique -> Format -> VirtualReg
    mkVirtualReg Unique
    vu Format
    II32))

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

            code :: OrdList Instr
    code = 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 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 forall a b. (a -> b) -> a -> b
    $ Int -> Imm
    ImmInt Int
    half2)
                    ]
      forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> Reg -> ChildCode64
    ChildCode64 OrdList Instr
    code Reg
    rlo)

    iselExpr64 (CmmMachOp (MO_Add Width
    _) [CmmExpr
    e1,CmmExpr
    e2]) = do
       ChildCode64 OrdList Instr
    code1 Reg
    r1lo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    e1
       ChildCode64 OrdList Instr
    code2 Reg
    r2lo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    e2
       (Reg
    rlo,Reg
    rhi) <- Format -> NatM (Reg, Reg)
    getNewRegPairNat Format
    II32
       let
            r1hi :: Reg
    r1hi = Reg -> Reg
    getHiVRegFromLo Reg
    r1lo
            r2hi :: Reg
    r2hi = Reg -> Reg
    getHiVRegFromLo Reg
    r2lo
            code :: OrdList Instr
    code =  OrdList Instr
    code1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    OrdList Instr
    code2 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    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 ]
       forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> Reg -> ChildCode64
    ChildCode64 OrdList Instr
    code Reg
    rlo)

    iselExpr64 (CmmMachOp (MO_Sub Width
    _) [CmmExpr
    e1,CmmExpr
    e2]) = do
       ChildCode64 OrdList Instr
    code1 Reg
    r1lo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    e1
       ChildCode64 OrdList Instr
    code2 Reg
    r2lo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    e2
       (Reg
    rlo,Reg
    rhi) <- Format -> NatM (Reg, Reg)
    getNewRegPairNat Format
    II32
       let
            r1hi :: Reg
    r1hi = Reg -> Reg
    getHiVRegFromLo Reg
    r1lo
            r2hi :: Reg
    r2hi = Reg -> Reg
    getHiVRegFromLo Reg
    r2lo
            code :: OrdList Instr
    code =  OrdList Instr
    code1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    OrdList Instr
    code2 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    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 ]
       forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr -> Reg -> ChildCode64
    ChildCode64 OrdList Instr
    code Reg
    rlo)

    iselExpr64 (CmmMachOp (MO_UU_Conv Width
    W32 Width
    W64) [CmmExpr
    expr]) = do
        (Reg
    expr_reg,OrdList Instr
    expr_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    expr
        (Reg
    rlo, Reg
    rhi) <- Format -> NatM (Reg, Reg)
    getNewRegPairNat Format
    II32
        let mov_hi :: Instr
    mov_hi = Reg -> Imm -> Instr
    LI Reg
    rhi (Int -> Imm
    ImmInt Int
    0)
            mov_lo :: Instr
    mov_lo = Reg -> Reg -> Instr
    MR Reg
    rlo Reg
    expr_reg
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ OrdList Instr -> Reg -> ChildCode64
    ChildCode64 (OrdList Instr
    expr_code forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_lo forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_hi)
                             Reg
    rlo

    iselExpr64 (CmmMachOp (MO_SS_Conv Width
    W32 Width
    W64) [CmmExpr
    expr]) = do
        (Reg
    expr_reg,OrdList Instr
    expr_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    expr
        (Reg
    rlo, Reg
    rhi) <- Format -> NatM (Reg, Reg)
    getNewRegPairNat Format
    II32
        let mov_hi :: Instr
    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 :: Instr
    mov_lo = Reg -> Reg -> Instr
    MR Reg
    rlo Reg
    expr_reg
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ OrdList Instr -> Reg -> ChildCode64
    ChildCode64 (OrdList Instr
    expr_code forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_lo forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_hi)
                             Reg
    rlo
    iselExpr64 CmmExpr
    expr
       = do
         Platform
    platform <- NatM Platform
    getPlatform
         forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "iselExpr64(powerpc)" (Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform CmmExpr
    expr)

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

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

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

    getRegister' NCGConfig
    _ Platform
    platform (CmmReg CmmReg
    reg)
      = forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> Reg -> OrdList Instr -> Register
    Fixed (CmmType -> Format
    cmmTypeFormat (Platform -> CmmReg -> CmmType
    cmmRegType Platform
    platform CmmReg
    reg))
                      (Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform CmmReg
    reg) 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 (Platform -> CmmExpr -> CmmExpr
    mangleIndexTree Platform
    platform 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
      ChildCode64 OrdList Instr
    code Reg
    rlo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    x
      forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> OrdList Instr -> Register
    Fixed Format
    II32 (Reg -> Reg
    getHiVRegFromLo Reg
    rlo) OrdList Instr
    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
      ChildCode64 OrdList Instr
    code Reg
    rlo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    x
      forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> OrdList Instr -> Register
    Fixed Format
    II32 (Reg -> Reg
    getHiVRegFromLo Reg
    rlo) OrdList Instr
    code

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

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

    getRegister' NCGConfig
    _ Platform
    platform (CmmLoad CmmExpr
    mem CmmType
    pk AlignmentSpec
    _)
     | Bool -> Bool
    not (CmmType -> Bool
    isWord64 CmmType
    pk) = do
            Amode AddrMode
    addr OrdList Instr
    addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
            let code :: Reg -> OrdList Instr
    code Reg
    dst = ASSERT((targetClassOfReg platform dst == RcDouble) == isFloatType pk)
                           OrdList Instr
    addr_code forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    format Reg
    dst AddrMode
    addr
            forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format Reg -> OrdList Instr
    code)
     | Bool -> Bool
    not (Platform -> Bool
    target32Bit Platform
    platform) = do
            Amode AddrMode
    addr OrdList Instr
    addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    DS CmmExpr
    mem
            let code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    addr_code forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II64 Reg
    dst AddrMode
    addr
            forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II64 Reg -> OrdList Instr
    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 AddrMode
    addr OrdList Instr
    addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II32 (\Reg
    dst -> OrdList Instr
    addr_code 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 AddrMode
    addr OrdList Instr
    addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II32 (\Reg
    dst -> OrdList Instr
    addr_code 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 AddrMode
    addr OrdList Instr
    addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II64 (\Reg
    dst -> OrdList Instr
    addr_code 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 AddrMode
    addr OrdList Instr
    addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II64 (\Reg
    dst -> OrdList Instr
    addr_code 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 AddrMode
    addr OrdList Instr
    addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II32 (\Reg
    dst -> OrdList Instr
    addr_code 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 AddrMode
    addr OrdList Instr
    addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II32 (\Reg
    dst -> OrdList Instr
    addr_code 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 AddrMode
    addr OrdList Instr
    addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II64 (\Reg
    dst -> OrdList Instr
    addr_code 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 AddrMode
    addr OrdList Instr
    addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II64 (\Reg
    dst -> OrdList Instr
    addr_code 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 AddrMode
    addr OrdList Instr
    addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    mem
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II64 (\Reg
    dst -> OrdList Instr
    addr_code 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 AddrMode
    addr OrdList Instr
    addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    DS CmmExpr
    mem
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II64 (\Reg
    dst -> OrdList Instr
    addr_code 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 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 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 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
    _ -> forall a. 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 Register
    e_code <- NCGConfig -> Platform -> CmmExpr -> NatM Register
    getRegister' NCGConfig
    config Platform
    platform CmmExpr
    expr
                     forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> Format -> Register
    swizzleRegisterRep Register
    e_code Format
    new_format)

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

    getRegister' NCGConfig
    _ 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
    _ <- 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 forall a b. (a -> b) -> a -> b
    $ Integer -> Width -> CmmLit
    CmmInt Integer
    imm Width
    immrep)
              CmmLit CmmLit
    lit
                -> do
                    (Reg
    src, OrdList Instr
    srcCode) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
                    let imm :: Imm
    imm = CmmLit -> Imm
    litToImm CmmLit
    lit
                        code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    srcCode forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` 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))
                                    ]
                    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    II32 Reg -> OrdList Instr
    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
    _ <- 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 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
    _ <- 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
            (Reg
    src1, OrdList Instr
    code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
            (Reg
    src2, OrdList Instr
    code2) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    y
            let
              format :: Format
    format = Width -> Format
    intFormat Width
    rep
              code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    code1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code2
                           forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` 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
                                        ]
            forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format Reg -> OrdList Instr
    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 forall a. Eq a => a -> a -> Bool
    == -Integer
    8 Bool -> Bool -> Bool
    || Integer
    imm forall a. Eq a => a -> a -> Bool
    == -Integer
    4
                -> do
                    (Reg
    src, OrdList Instr
    srcCode) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
                    let clear_mask :: Int
    clear_mask = if Integer
    imm forall a. Eq a => a -> a -> Bool
    == -Integer
    4 then Int
    2 else Int
    3
                        fmt :: Format
    fmt = Width -> Format
    intFormat Width
    rep
                        code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    srcCode
                                   forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` forall a. a -> OrdList a
    unitOL (Format -> Reg -> Reg -> Int -> Instr
    CLRRI Format
    fmt Reg
    dst Reg
    src Int
    clear_mask)
                    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    fmt Reg -> OrdList Instr
    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
    _         -> forall a. 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
          Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    fmt
          Reg -> OrdList Instr
    code <- Width
    -> Bool -> Reg -> CmmExpr -> CmmExpr -> NatM (Reg -> OrdList Instr)
    remainderCode Width
    rep Bool
    sgn Reg
    tmp CmmExpr
    x CmmExpr
    y
          forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    fmt Reg -> OrdList Instr
    code)

    getRegister' NCGConfig
    _ Platform
    _ (CmmLit (CmmInt Integer
    i Width
    rep))
      | Just Imm
    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 = forall a. a -> OrdList a
    unitOL (Reg -> Imm -> Instr
    LI Reg
    dst Imm
    imm)
        in
            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
        CLabel
    lbl <- NatM CLabel
    getNewLabelNat
        CmmExpr
    dynRef <- forall (m :: * -> *).
    CmmMakeDynamicReferenceM m =>
    NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
    cmmMakeDynamicReference NCGConfig
    config ReferenceKind
    DataReference CLabel
    lbl
        Amode AddrMode
    addr OrdList Instr
    addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    dynRef
        let format :: Format
    format = Width -> Format
    floatFormat Width
    frep
            code :: Reg -> OrdList Instr
    code Reg
    dst =
                Section -> RawCmmStatics -> Instr
    LDATA (SectionType -> CLabel -> Section
    Section SectionType
    ReadOnlyData CLabel
    lbl)
                      (forall (a :: Bool). CLabel -> [CmmStatic] -> GenCmmStatics a
    CmmStaticsRaw CLabel
    lbl [CmmLit -> CmmStatic
    CmmStaticLit (Rational -> Width -> CmmLit
    CmmFloat Rational
    f Width
    frep)])
                forall a. a -> OrdList a -> OrdList a
    `consOL` (OrdList Instr
    addr_code forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    format Reg
    dst AddrMode
    addr)
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format Reg -> OrdList Instr
    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 = 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 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 CLabel
    lbl <- NatM CLabel
    getNewLabelNat
           CmmExpr
    dynRef <- forall (m :: * -> *).
    CmmMakeDynamicReferenceM m =>
    NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
    cmmMakeDynamicReference NCGConfig
    config ReferenceKind
    DataReference CLabel
    lbl
           Amode AddrMode
    addr OrdList Instr
    addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    dynRef
           let rep :: CmmType
    rep = Platform -> CmmLit -> CmmType
    cmmLitType Platform
    platform CmmLit
    lit
               format :: Format
    format = CmmType -> Format
    cmmTypeFormat CmmType
    rep
               code :: Reg -> OrdList Instr
    code Reg
    dst =
                Section -> RawCmmStatics -> Instr
    LDATA (SectionType -> CLabel -> Section
    Section SectionType
    ReadOnlyData CLabel
    lbl) (forall (a :: Bool). CLabel -> [CmmStatic] -> GenCmmStatics a
    CmmStaticsRaw CLabel
    lbl [CmmLit -> CmmStatic
    CmmStaticLit CmmLit
    lit])
                forall a. a -> OrdList a -> OrdList a
    `consOL` (OrdList Instr
    addr_code forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    format Reg
    dst AddrMode
    addr)
           forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format Reg -> OrdList Instr
    code)

    getRegister' NCGConfig
    _ Platform
    platform CmmExpr
    other = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister(ppc)" (Platform -> CmmExpr -> SDoc
    pprExpr 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
    _)
      = do Platform
    platform <- NatM Platform
    getPlatform
           InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    inf (Platform -> CmmExpr -> CmmExpr
    mangleIndexTree Platform
    platform CmmExpr
    tree)

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

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

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

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

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

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

       -- optimize addition with 32-bit immediate
       -- (needed for PIC)
    getAmode InstrForm
    _ (CmmMachOp (MO_Add Width
    W32) [CmmExpr
    x, CmmLit CmmLit
    lit])
      = do
            Platform
    platform <- NatM Platform
    getPlatform
            (Reg
    src, OrdList Instr
    srcCode) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
            let imm :: Imm
    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
                        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
                        Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    II32
                        let code :: OrdList Instr
    code = OrdList Instr
    srcCode forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Imm -> Instr
    ADDIS Reg
    tmp Reg
    src (Imm -> Imm
    HA Imm
    imm)
                        forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode -> OrdList Instr -> Amode
    Amode (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    tmp (Imm -> Imm
    LO Imm
    imm)) OrdList Instr
    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
    platform <- NatM Platform
    getPlatform
            case Platform -> Arch
    platformArch Platform
    platform of
                 Arch
    ArchPPC -> do
                     Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    II32
                     let imm :: Imm
    imm = CmmLit -> Imm
    litToImm CmmLit
    lit
                         code :: OrdList Instr
    code = forall a. a -> OrdList a
    unitOL (Reg -> Imm -> Instr
    LIS Reg
    tmp (Imm -> Imm
    HA Imm
    imm))
                     forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode -> OrdList Instr -> Amode
    Amode (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    tmp (Imm -> Imm
    LO Imm
    imm)) OrdList Instr
    code)
                 Arch
    _        -> do -- TODO: Load from TOC,
                                -- see getRegister' _ (CmmLit lit)
                     Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    II64
                     let imm :: Imm
    imm = CmmLit -> Imm
    litToImm CmmLit
    lit
                         code :: OrdList Instr
    code =  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)
                              ]
                     forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode -> OrdList Instr -> Amode
    Amode (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    tmp (Imm -> Imm
    LO Imm
    imm)) OrdList Instr
    code)

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

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

    getAmode InstrForm
    _ CmmExpr
    other
      = do
            (Reg
    reg, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    other
            let
                off :: Imm
    off  = Int -> Imm
    ImmInt Int
    0
            forall (m :: * -> *) a. Monad m => a -> m a
    return (AddrMode -> OrdList Instr -> Amode
    Amode (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    reg Imm
    off) OrdList Instr
    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
    _ -> forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getCondCode(powerpc)" (MachOp -> SDoc
    pprMachOp MachOp
    mop)

    getCondCode CmmExpr
    _ = forall a. 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
    platform <- NatM Platform
    getPlatform
      Bool -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode' (Platform -> Bool
    target32Bit Platform
    platform) Cond
    cond Width
    width CmmExpr
    x CmmExpr
    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
          ChildCode64 OrdList Instr
    code_x Reg
    x_lo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    x
          ChildCode64 OrdList Instr
    code_y Reg
    y_lo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    y
          let x_hi :: Reg
    x_hi = Reg -> Reg
    getHiVRegFromLo Reg
    x_lo
              y_hi :: Reg
    y_hi = Reg -> Reg
    getHiVRegFromLo Reg
    y_lo
          BlockId
    end_lbl <- NatM BlockId
    getBlockIdNat
          let code :: OrdList Instr
    code = OrdList Instr
    code_x forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` 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 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 forall a. Maybe a
    Nothing

                     , BlockId -> Instr
    NEWBLOCK BlockId
    end_lbl
                     ]
          forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Cond -> OrdList Instr -> CondCode
    CondCode Bool
    False Cond
    cond OrdList Instr
    code)
      | Bool
    otherwise
      = do
          ChildCode64 OrdList Instr
    code_x Reg
    x_lo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    x
          ChildCode64 OrdList Instr
    code_y Reg
    y_lo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    y
          let x_hi :: Reg
    x_hi = Reg -> Reg
    getHiVRegFromLo Reg
    x_lo
              y_hi :: Reg
    y_hi = Reg -> Reg
    getHiVRegFromLo Reg
    y_lo
          BlockId
    end_lbl <- NatM BlockId
    getBlockIdNat
          BlockId
    cmp_lo  <- NatM BlockId
    getBlockIdNat
          let code :: OrdList Instr
    code = OrdList Instr
    code_x forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code_y forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` 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 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 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 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 forall a. Maybe a
    Nothing

                     , BlockId -> Instr
    NEWBLOCK BlockId
    end_lbl
                     ]
          forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Cond -> OrdList Instr -> CondCode
    CondCode Bool
    False Cond
    cond OrdList Instr
    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 forall a b. (a -> b) -> a -> b
    $ Cond -> Bool
    condUnsigned Cond
    cond,
        Just Imm
    src2 <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    rep Bool
    False Integer
    imm
      = do
          (Reg
    src1, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
          let code' :: OrdList Instr
    code' = OrdList Instr
    code forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> RI -> Instr
    AND Reg
    r0 Reg
    src1 (Imm -> RI
    RIImm Imm
    src2)
          forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Cond -> OrdList Instr -> CondCode
    CondCode Bool
    False Cond
    cond OrdList Instr
    code')

    condIntCode' Bool
    _ Cond
    cond Width
    width CmmExpr
    x (CmmLit (CmmInt Integer
    y Width
    rep))
      | Just Imm
    src2 <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    rep (Bool -> Bool
    not forall a b. (a -> b) -> a -> b
    $ Cond -> Bool
    condUnsigned Cond
    cond) Integer
    y
      = do
          let op_len :: Width
    op_len = 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
          (Reg
    src1, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (CmmExpr -> CmmExpr
    extend CmmExpr
    x)
          let format :: Format
    format = Width -> Format
    intFormat Width
    op_len
              code' :: OrdList Instr
    code' = OrdList Instr
    code 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)
          forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Cond -> OrdList Instr -> CondCode
    CondCode Bool
    False Cond
    cond OrdList Instr
    code')

    condIntCode' Bool
    _ Cond
    cond Width
    width CmmExpr
    x CmmExpr
    y = do
      let op_len :: Width
    op_len = 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
      (Reg
    src1, OrdList Instr
    code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (CmmExpr -> CmmExpr
    extend CmmExpr
    x)
      (Reg
    src2, OrdList Instr
    code2) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (CmmExpr -> CmmExpr
    extend CmmExpr
    y)
      let format :: Format
    format = Width -> Format
    intFormat Width
    op_len
          code' :: OrdList Instr
    code' = OrdList Instr
    code1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code2 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)
      forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Cond -> OrdList Instr -> CondCode
    CondCode Bool
    False Cond
    cond OrdList Instr
    code')

    condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    cond CmmExpr
    x CmmExpr
    y = do
        (Reg
    src1, OrdList Instr
    code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
        (Reg
    src2, OrdList Instr
    code2) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    y
        let
            code' :: OrdList Instr
    code'  = OrdList Instr
    code1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code2 forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Instr
    FCMP Reg
    src1 Reg
    src2
            code'' :: OrdList Instr
    code'' = case Cond
    cond of -- twiddle CR to handle unordered case
                        Cond
    GE -> OrdList Instr
    code' forall a. OrdList a -> a -> OrdList a
    `snocOL` Int -> Int -> Int -> Instr
    CRNOR Int
    ltbit Int
    eqbit Int
    gtbit
                        Cond
    LE -> OrdList Instr
    code' 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
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Cond -> OrdList Instr -> CondCode
    CondCode Bool
    True Cond
    cond OrdList Instr
    code'')

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

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

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

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

    assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_IntCode Format
    pk CmmExpr
    addr CmmExpr
    src = do
        (Reg
    srcReg, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    src
        Amode AddrMode
    dstAddr OrdList Instr
    addr_code <- case Format
    pk of
                                    Format
    II64 -> InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    DS CmmExpr
    addr
                                    Format
    _    -> InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D  CmmExpr
    addr
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    addr_code forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    ST Format
    pk Reg
    srcReg AddrMode
    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
    platform <- NatM Platform
    getPlatform
            let dst :: Reg
    dst = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform CmmReg
    reg
            Register
    r <- CmmExpr -> NatM Register
    getRegister CmmExpr
    src
            forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ case Register
    r of
                Any Format
    _ Reg -> OrdList Instr
    code         -> Reg -> OrdList Instr
    code Reg
    dst
                Fixed Format
    _ Reg
    freg OrdList Instr
    fcode -> OrdList Instr
    fcode 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
      = forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. a -> OrdList a
    unitOL forall a b. (a -> b) -> a -> b
    $ CLabel -> [Reg] -> Instr
    JMP CLabel
    lbl [Reg]
    regs)

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

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

    genJump' :: CmmExpr -> GenCCallPlatform -> [Reg] -> NatM (OrdList Instr)
    genJump' CmmExpr
    tree (GCP64ELF Int
    1) [Reg]
    regs
      = do
            (Reg
    target,OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    tree
            forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    code
                   forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II64 Reg
    r11 (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    target (Int -> Imm
    ImmInt Int
    0))
                   forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II64 Reg
    toc (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    target (Int -> Imm
    ImmInt Int
    8))
                   forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Instr
    MTCTR Reg
    r11
                   forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    LD Format
    II64 Reg
    r11 (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    target (Int -> Imm
    ImmInt Int
    16))
                   forall a. OrdList a -> a -> OrdList a
    `snocOL` [Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
    BCTR [] forall a. Maybe a
    Nothing [Reg]
    regs)

    genJump' CmmExpr
    tree (GCP64ELF Int
    2) [Reg]
    regs
      = do
            (Reg
    target,OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    tree
            forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    code
                   forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Instr
    MR Reg
    r12 Reg
    target
                   forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Instr
    MTCTR Reg
    r12
                   forall a. OrdList a -> a -> OrdList a
    `snocOL` [Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
    BCTR [] forall a. Maybe a
    Nothing [Reg]
    regs)

    genJump' CmmExpr
    tree GenCCallPlatform
    _ [Reg]
    regs
      = do
            (Reg
    target,OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    tree
            forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    code forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Instr
    MTCTR Reg
    target forall a. OrdList a -> a -> OrdList a
    `snocOL` [Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
    BCTR [] forall a. Maybe a
    Nothing [Reg]
    regs)

    -- -----------------------------------------------------------------------------
    --  Unconditional branches
    genBranch :: BlockId -> NatM InstrBlock
    genBranch :: BlockId -> NatM (OrdList Instr)
    genBranch = forall (m :: * -> *) a. Monad m => a -> m a
    return forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a. [a] -> OrdList a
    toOL 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 Bool
    _ Cond
    cond OrdList Instr
    code <- CmmExpr -> NatM CondCode
    getCondCode CmmExpr
    bool
      forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList Instr
    code forall a. OrdList a -> a -> OrdList a
    `snocOL` Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    cond BlockId
    id Maybe Bool
    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_ReadBarrier) [CmmFormal]
    _ [CmmExpr]
    _
     = forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ forall a. a -> OrdList a
    unitOL Instr
    LWSYNC
    genCCall (PrimTarget CallishMachOp
    MO_WriteBarrier) [CmmFormal]
    _ [CmmExpr]
    _
     = forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ forall a. a -> OrdList a
    unitOL Instr
    LWSYNC

    genCCall (PrimTarget CallishMachOp
    MO_Touch) [CmmFormal]
    _ [CmmExpr]
    _
     = forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ forall a. OrdList a
    nilOL

    genCCall (PrimTarget (MO_Prefetch_Data Int
    _)) [CmmFormal]
    _ [CmmExpr]
    _
     = forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ forall a. OrdList a
    nilOL

    genCCall (PrimTarget (MO_AtomicRMW Width
    width AtomicMachOp
    amop)) [CmmFormal
    dst] [CmmExpr
    addr, CmmExpr
    n]
     = do Platform
    platform <- NatM Platform
    getPlatform
          let fmt :: Format
    fmt      = Width -> Format
    intFormat Width
    width
              reg_dst :: Reg
    reg_dst  = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
          (Instr
    instr, OrdList 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 <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    width Bool
    True (-Integer
    i)
                       -> 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), forall a. OrdList a
    nilOL)
                    CmmExpr
    _
                       -> do
                             (Reg
    n_reg, OrdList Instr
    n_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    n
                             forall (m :: * -> *) a. Monad m => a -> m a
    return  (Reg -> Reg -> Reg -> Instr
    SUBF Reg
    reg_dst Reg
    n_reg Reg
    reg_dst, OrdList Instr
    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 (Reg
    n_reg, OrdList Instr
    n_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    n
                               forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg -> Reg -> Reg -> Instr
    NAND Reg
    reg_dst Reg
    reg_dst Reg
    n_reg, OrdList Instr
    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 AddrMode
    addr_reg OrdList Instr
    addr_code <- CmmExpr -> NatM Amode
    getAmodeIndex CmmExpr
    addr
          BlockId
    lbl_retry <- NatM BlockId
    getBlockIdNat
          forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    n_code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    addr_code
            forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` forall a. [a] -> OrdList a
    toOL [ Instr
    HWSYNC
                         , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    lbl_retry forall a. Maybe a
    Nothing

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

    genCCall (PrimTarget (MO_AtomicRead Width
    width)) [CmmFormal
    dst] [CmmExpr
    addr]
     = do Platform
    platform <- NatM Platform
    getPlatform
          let fmt :: Format
    fmt      = Width -> Format
    intFormat Width
    width
              reg_dst :: Reg
    reg_dst  = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
              form :: InstrForm
    form     = if Width -> Int
    widthInBits Width
    width forall a. Eq a => a -> a -> Bool
    == Int
    64 then InstrForm
    DS else InstrForm
    D
          Amode AddrMode
    addr_reg OrdList Instr
    addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    form CmmExpr
    addr
          BlockId
    lbl_end <- NatM BlockId
    getBlockIdNat
          forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    addr_code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` forall a. [a] -> OrdList a
    toOL [ Instr
    HWSYNC
                                          , Format -> Reg -> AddrMode -> Instr
    LD Format
    fmt Reg
    reg_dst AddrMode
    addr_reg
                                          , Format -> Reg -> RI -> Instr
    CMP Format
    fmt Reg
    reg_dst (Reg -> RI
    RIReg Reg
    reg_dst)
                                          , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    NE BlockId
    lbl_end (forall a. a -> Maybe a
    Just Bool
    False)
                                          , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    lbl_end forall a. Maybe a
    Nothing
                                -- See Note [Seemingly useless cmp and bne]
                                          , BlockId -> Instr
    NEWBLOCK BlockId
    lbl_end
                                          , Instr
    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)) [] [CmmExpr
    addr, CmmExpr
    val] = do
        OrdList Instr
    code <- Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
    assignMem_IntCode (Width -> Format
    intFormat Width
    width) CmmExpr
    addr CmmExpr
    val
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ forall a. a -> OrdList a
    unitOL(Instr
    HWSYNC) forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code

    genCCall (PrimTarget (MO_Clz Width
    width)) [CmmFormal
    dst] [CmmExpr
    src]
     = do Platform
    platform <- NatM Platform
    getPlatform
          let reg_dst :: Reg
    reg_dst = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
          if Platform -> Bool
    target32Bit Platform
    platform Bool -> Bool -> Bool
    && Width
    width forall a. Eq a => a -> a -> Bool
    == Width
    W64
            then do
              ChildCode64 OrdList Instr
    code Reg
    vr_lo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    src
              BlockId
    lbl1 <- NatM BlockId
    getBlockIdNat
              BlockId
    lbl2 <- NatM BlockId
    getBlockIdNat
              BlockId
    lbl3 <- NatM BlockId
    getBlockIdNat
              let vr_hi :: Reg
    vr_hi = Reg -> Reg
    getHiVRegFromLo Reg
    vr_lo
                  cntlz :: OrdList Instr
    cntlz = 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 forall a. Maybe a
    Nothing
                               , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    lbl1 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 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 forall a. Maybe a
    Nothing

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

    genCCall (PrimTarget (MO_Ctz Width
    width)) [CmmFormal
    dst] [CmmExpr
    src]
     = do Platform
    platform <- NatM Platform
    getPlatform
          let reg_dst :: Reg
    reg_dst = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dst)
          if Platform -> Bool
    target32Bit Platform
    platform Bool -> Bool -> Bool
    && Width
    width forall a. Eq a => a -> a -> Bool
    == Width
    W64
            then do
              let format :: Format
    format = Format
    II32
              ChildCode64 OrdList Instr
    code Reg
    vr_lo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    src
              BlockId
    lbl1 <- NatM BlockId
    getBlockIdNat
              BlockId
    lbl2 <- NatM BlockId
    getBlockIdNat
              BlockId
    lbl3 <- NatM BlockId
    getBlockIdNat
              Reg
    x' <- Format -> NatM Reg
    getNewRegNat Format
    format
              Reg
    x'' <- Format -> NatM Reg
    getNewRegNat Format
    format
              Reg
    r' <- Format -> NatM Reg
    getNewRegNat Format
    format
              OrdList Instr
    cnttzlo <- Format -> Reg -> Reg -> NatM (OrdList Instr)
    cnttz Format
    format Reg
    reg_dst Reg
    vr_lo
              let vr_hi :: Reg
    vr_hi = Reg -> Reg
    getHiVRegFromLo Reg
    vr_lo
                  cnttz64 :: OrdList Instr
    cnttz64 = 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 forall a. Maybe a
    Nothing
                                 , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    lbl1 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 forall a. Maybe a
    Nothing

                                 , BlockId -> Instr
    NEWBLOCK BlockId
    lbl2
                                 ]
                            forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    cnttzlo forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                            forall a. [a] -> OrdList a
    toOL [ Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    lbl3 forall a. Maybe a
    Nothing

                                 , BlockId -> Instr
    NEWBLOCK BlockId
    lbl3
                                 ]
              forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    cnttz64
            else do
              let format :: Format
    format = if Width
    width forall a. Eq a => a -> a -> Bool
    == Width
    W64 then Format
    II64 else Format
    II32
              (Reg
    s_reg, OrdList Instr
    s_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    src
              (Reg
    reg_ctz, OrdList Instr
    pre_code) <-
                case Width
    width of
                  Width
    W64 -> forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    s_reg, forall a. OrdList a
    nilOL)
                  Width
    W32 -> forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    s_reg, forall a. OrdList a
    nilOL)
                  Width
    W16 -> do
                    Reg
    reg_tmp <- Format -> NatM Reg
    getNewRegNat Format
    format
                    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    reg_tmp, forall a. a -> OrdList a
    unitOL forall a b. (a -> b) -> a -> b
    $ Reg -> Reg -> Imm -> Instr
    ORIS Reg
    reg_tmp Reg
    s_reg (Int -> Imm
    ImmInt Int
    1))
                  Width
    W8  -> do
                    Reg
    reg_tmp <- Format -> NatM Reg
    getNewRegNat Format
    format
                    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    reg_tmp, forall a. a -> OrdList a
    unitOL forall a b. (a -> b) -> a -> b
    $ Reg -> Reg -> RI -> Instr
    OR Reg
    reg_tmp Reg
    s_reg (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    256)))
                  Width
    _   -> forall a. String -> a
    panic String
    "genCall: Ctz wrong format"
              OrdList Instr
    ctz_code <- Format -> Reg -> Reg -> NatM (OrdList Instr)
    cnttz Format
    format Reg
    reg_dst Reg
    reg_ctz
              forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    s_code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    pre_code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    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 forall a. Num a => a -> a -> a
    * Format -> Int
    formatInBytes Format
    format
                Reg
    x' <- Format -> NatM Reg
    getNewRegNat Format
    format
                Reg
    x'' <- Format -> NatM Reg
    getNewRegNat Format
    format
                Reg
    r' <- Format -> NatM Reg
    getNewRegNat Format
    format
                forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ forall a. [a] -> OrdList a
    toOL [ Reg -> Reg -> RI -> Instr
    ADD Reg
    x' Reg
    src (Imm -> RI
    RIImm (Int -> Imm
    ImmInt (-Int
    1)))
                              , Reg -> Reg -> Reg -> Instr
    ANDC Reg
    x'' Reg
    x' Reg
    src
                              , Format -> Reg -> Reg -> Instr
    CNTLZ Format
    format Reg
    r' Reg
    x''
                              , Reg -> Reg -> RI -> Instr
    SUBFC Reg
    dst Reg
    r' (Imm -> RI
    RIImm (Int -> Imm
    ImmInt (Int
    format_bits)))
                              ]

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

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

                                       , BlockId -> Instr
    NEWBLOCK BlockId
    again1
                                         -- if (q1 >= b || q1*vn0 > b*rhat + un1)
                                       , Format -> Reg -> RI -> Instr
    CMPL Format
    fmt Reg
    q1 (Reg -> RI
    RIReg Reg
    b)
                                       , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    GEU BlockId
    then1 forall a. Maybe a
    Nothing
                                       , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    no1 forall a. Maybe a
    Nothing

                                       , BlockId -> Instr
    NEWBLOCK BlockId
    no1
                                       , Format -> Reg -> Reg -> RI -> Instr
    MULL Format
    fmt Reg
    tmp Reg
    q1 (Reg -> RI
    RIReg Reg
    vn0)
                                       , Format -> Reg -> Reg -> RI -> Instr
    SL Format
    fmt Reg
    tmp1 Reg
    rhat (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    half))
                                       , Reg -> Reg -> RI -> Instr
    ADD Reg
    tmp1 Reg
    tmp1 (Reg -> RI
    RIReg Reg
    un1)
                                       , Format -> Reg -> RI -> Instr
    CMPL Format
    fmt Reg
    tmp (Reg -> RI
    RIReg Reg
    tmp1)
                                       , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    LEU BlockId
    endif1 forall a. Maybe a
    Nothing
                                       , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    then1 forall a. Maybe a
    Nothing

                                       , BlockId -> Instr
    NEWBLOCK BlockId
    then1
                                         -- q1 = q1 - 1
                                       , Reg -> Reg -> RI -> Instr
    ADD Reg
    q1 Reg
    q1 (Imm -> RI
    RIImm (Int -> Imm
    ImmInt (-Int
    1)))
                                         -- rhat = rhat + vn1
                                       , Reg -> Reg -> RI -> Instr
    ADD Reg
    rhat Reg
    rhat (Reg -> RI
    RIReg Reg
    vn1)
                                         -- if (rhat < b) goto again1
                                       , Format -> Reg -> RI -> Instr
    CMPL Format
    fmt Reg
    rhat (Reg -> RI
    RIReg Reg
    b)
                                       , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    LTT BlockId
    again1 forall a. Maybe a
    Nothing
                                       , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    endif1 forall a. Maybe a
    Nothing

                                       , BlockId -> Instr
    NEWBLOCK BlockId
    endif1
                                         -- un21 = un32*b + un1 - q1*v
                                       , Format -> Reg -> Reg -> RI -> Instr
    SL Format
    fmt Reg
    un21 Reg
    un32 (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    half))
                                       , Reg -> Reg -> RI -> Instr
    ADD Reg
    un21 Reg
    un21 (Reg -> RI
    RIReg Reg
    un1)
                                       , Format -> Reg -> Reg -> RI -> Instr
    MULL Format
    fmt Reg
    tmp Reg
    q1 (Reg -> RI
    RIReg Reg
    v)
                                       , Reg -> Reg -> Reg -> Instr
    SUBF Reg
    un21 Reg
    tmp Reg
    un21
                                         -- compute second quotient digit
                                         -- q0 = un21/vn1
                                       , Format -> Bool -> Reg -> Reg -> Reg -> Instr
    DIV Format
    fmt Bool
    False Reg
    q0 Reg
    un21 Reg
    vn1
                                         -- rhat = un21- q0*vn1
                                       , Format -> Reg -> Reg -> RI -> Instr
    MULL Format
    fmt Reg
    tmp Reg
    q0 (Reg -> RI
    RIReg Reg
    vn1)
                                       , Reg -> Reg -> Reg -> Instr
    SUBF Reg
    rhat Reg
    tmp Reg
    un21
                                       , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    again2 forall a. Maybe a
    Nothing

                                       , BlockId -> Instr
    NEWBLOCK BlockId
    again2
                                         -- if (q0>b || q0*vn0 > b*rhat + un0)
                                       , Format -> Reg -> RI -> Instr
    CMPL Format
    fmt Reg
    q0 (Reg -> RI
    RIReg Reg
    b)
                                       , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    GEU BlockId
    then2 forall a. Maybe a
    Nothing
                                       , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    no2 forall a. Maybe a
    Nothing

                                       , BlockId -> Instr
    NEWBLOCK BlockId
    no2
                                       , Format -> Reg -> Reg -> RI -> Instr
    MULL Format
    fmt Reg
    tmp Reg
    q0 (Reg -> RI
    RIReg Reg
    vn0)
                                       , Format -> Reg -> Reg -> RI -> Instr
    SL Format
    fmt Reg
    tmp1 Reg
    rhat (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    half))
                                       , Reg -> Reg -> RI -> Instr
    ADD Reg
    tmp1 Reg
    tmp1 (Reg -> RI
    RIReg Reg
    un0)
                                       , Format -> Reg -> RI -> Instr
    CMPL Format
    fmt Reg
    tmp (Reg -> RI
    RIReg Reg
    tmp1)
                                       , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    LEU BlockId
    endif2 forall a. Maybe a
    Nothing
                                       , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    then2 forall a. Maybe a
    Nothing

                                       , BlockId -> Instr
    NEWBLOCK BlockId
    then2
                                         -- q0 = q0 - 1
                                       , Reg -> Reg -> RI -> Instr
    ADD Reg
    q0 Reg
    q0 (Imm -> RI
    RIImm (Int -> Imm
    ImmInt (-Int
    1)))
                                         -- rhat = rhat + vn1
                                       , Reg -> Reg -> RI -> Instr
    ADD Reg
    rhat Reg
    rhat (Reg -> RI
    RIReg Reg
    vn1)
                                         -- if (rhat<b) goto again2
                                       , Format -> Reg -> RI -> Instr
    CMPL Format
    fmt Reg
    rhat (Reg -> RI
    RIReg Reg
    b)
                                       , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    LTT BlockId
    again2 forall a. Maybe a
    Nothing
                                       , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    endif2 forall a. Maybe a
    Nothing

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

                  addcOp :: Platform -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    addcOp Platform
    platform [CmmFormal
    res_r, CmmFormal
    res_c] [CmmExpr
    arg_x, CmmExpr
    arg_y]
                    = Platform -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    add2Op Platform
    platform [CmmFormal
    res_c {-hi-}, CmmFormal
    res_r {-lo-}] [CmmExpr
    arg_x, CmmExpr
    arg_y]
                  addcOp Platform
    _ [CmmFormal]
    _ [CmmExpr]
    _
                    = forall a. 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 :: Platform -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    subcOp Platform
    platform [CmmFormal
    res_r, CmmFormal
    res_c] [CmmExpr
    arg_x, CmmExpr
    arg_y]
                    = do let reg_r :: Reg
    reg_r = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    res_r)
                             reg_c :: Reg
    reg_c = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    res_c)
                         (Reg
    x_reg, OrdList Instr
    x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    arg_x
                         (Reg
    y_reg, OrdList Instr
    y_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    arg_y
                         forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    y_code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    x_code
                                forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` forall a. [a] -> OrdList a
    toOL [ Reg -> Imm -> Instr
    LI Reg
    reg_c (Int -> Imm
    ImmInt Int
    0)
                                             , Reg -> Reg -> RI -> Instr
    SUBFC Reg
    reg_r Reg
    y_reg (Reg -> RI
    RIReg Reg
    x_reg)
                                             , Reg -> Reg -> Instr
    ADDZE Reg
    reg_c Reg
    reg_c
                                             , Reg -> Reg -> RI -> Instr
    XOR Reg
    reg_c Reg
    reg_c (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    1))
                                             ]
                  subcOp Platform
    _ [CmmFormal]
    _ [CmmExpr]
    _
                    = forall a. String -> a
    panic String
    "genCCall: Wrong number of arguments/results for subc"
                  addSubCOp :: (Reg -> Reg -> Reg -> Instr)
    -> Platform
    -> Width
    -> [CmmFormal]
    -> [CmmExpr]
    -> NatM (OrdList Instr)
    addSubCOp Reg -> Reg -> Reg -> Instr
    instr Platform
    platform Width
    width [CmmFormal
    res_r, CmmFormal
    res_c] [CmmExpr
    arg_x, CmmExpr
    arg_y]
                    = do let reg_r :: Reg
    reg_r = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    res_r)
                             reg_c :: Reg
    reg_c = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    res_c)
                         (Reg
    x_reg, OrdList Instr
    x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    arg_x
                         (Reg
    y_reg, OrdList Instr
    y_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    arg_y
                         forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    y_code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    x_code
                                forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` forall a. [a] -> OrdList a
    toOL [ Reg -> Reg -> Reg -> Instr
    instr Reg
    reg_r Reg
    y_reg Reg
    x_reg,
                                               -- SUBFO argument order reversed!
                                               Format -> Reg -> Instr
    MFOV (Width -> Format
    intFormat Width
    width) Reg
    reg_c
                                             ]
                  addSubCOp Reg -> Reg -> Reg -> Instr
    _ Platform
    _ Width
    _ [CmmFormal]
    _ [CmmExpr]
    _
                    = forall a. String -> a
    panic String
    "genCall: Wrong number of arguments/results for addC"
                  fabs :: Platform -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
    fabs Platform
    platform [CmmFormal
    res] [CmmExpr
    arg]
                    = do let res_r :: Reg
    res_r = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    res)
                         (Reg
    arg_reg, OrdList Instr
    arg_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    arg
                         forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ OrdList Instr
    arg_code forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Instr
    FABS Reg
    res_r Reg
    arg_reg
                  fabs Platform
    _ [CmmFormal]
    _ [CmmExpr]
    _
                    = forall a. 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
    _ -> forall a. 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
            (Int
    finalStack,OrdList Instr
    passArgumentsCode,[Reg]
    usedRegs) <- [(CmmExpr, CmmType, ForeignHint)]
    -> [Reg]
    -> [Reg]
    -> Int
    -> OrdList Instr
    -> [Reg]
    -> NatM (Int, OrdList Instr, [Reg])
    passArguments
                                                       (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
                                                       forall a. OrdList a
    nilOL []

            (Either CLabel CmmExpr
    labelOrExpr, Bool
    reduceToFF32) <- case ForeignTarget
    target of
                ForeignTarget (CmmLit (CmmLabel CLabel
    lbl)) ForeignConvention
    _ -> do
                    NatM ()
    uses_pic_base_implicitly
                    forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a b. a -> Either a b
    Left CLabel
    lbl, Bool
    False)
                ForeignTarget CmmExpr
    expr ForeignConvention
    _ -> do
                    NatM ()
    uses_pic_base_implicitly
                    forall (m :: * -> *) a. Monad m => a -> m a
    return (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 :: OrdList Instr
    codeBefore = Int -> OrdList Instr
    move_sp_down Int
    finalStack forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    passArgumentsCode
                codeAfter :: OrdList Instr
    codeAfter = Int -> OrdList Instr
    move_sp_up Int
    finalStack forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Bool -> OrdList Instr
    moveResult Bool
    reduceToFF32

            case Either CLabel CmmExpr
    labelOrExpr of
                Left CLabel
    lbl -> -- the linker does all the work for us
                    forall (m :: * -> *) a. Monad m => a -> m a
    return (         OrdList Instr
    codeBefore
                            forall a. OrdList a -> a -> OrdList a
    `snocOL` CLabel -> [Reg] -> Instr
    BL CLabel
    lbl [Reg]
    usedRegs
                            forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    maybeNOP -- some ABI require a NOP after BL
                            forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    codeAfter)
                Right CmmExpr
    dyn -> do -- implement call through function pointer
                    (Reg
    dynReg, OrdList Instr
    dynCode) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    dyn
                    case GenCCallPlatform
    gcp of
                         GCP64ELF Int
    1      -> forall (m :: * -> *) a. Monad m => a -> m a
    return ( OrdList Instr
    dynCode
                           forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    codeBefore
                           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))
                           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))
                           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))
                           forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Instr
    MTCTR Reg
    r11
                           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))
                           forall a. OrdList a -> a -> OrdList a
    `snocOL` [Reg] -> Instr
    BCTRL [Reg]
    usedRegs
                           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))
                           forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    codeAfter)
                         GCP64ELF Int
    2      -> forall (m :: * -> *) a. Monad m => a -> m a
    return ( OrdList Instr
    dynCode
                           forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    codeBefore
                           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))
                           forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Instr
    MR Reg
    r12 Reg
    dynReg
                           forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Instr
    MTCTR Reg
    r12
                           forall a. OrdList a -> a -> OrdList a
    `snocOL` [Reg] -> Instr
    BCTRL [Reg]
    usedRegs
                           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))
                           forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    codeAfter)
                         GenCCallPlatform
    GCPAIX          -> 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
                           forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    codeBefore
                           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))
                           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))
                           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))
                           forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Instr
    MTCTR Reg
    r11
                           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))
                           forall a. OrdList a -> a -> OrdList a
    `snocOL` [Reg] -> Instr
    BCTRL [Reg]
    usedRegs
                           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))
                           forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    codeAfter)
                         GenCCallPlatform
    _               -> forall (m :: * -> *) a. Monad m => a -> m a
    return ( OrdList Instr
    dynCode
                           forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Instr
    MTCTR Reg
    dynReg
                           forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  OrdList Instr
    codeBefore
                           forall a. OrdList a -> a -> OrdList a
    `snocOL` [Reg] -> Instr
    BCTRL [Reg]
    usedRegs
                           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
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (NCGConfig -> Bool
    ncgPIC NCGConfig
    config Bool -> Bool -> Bool
    && Platform -> Bool
    target32Bit Platform
    platform) forall a b. (a -> b) -> a -> b
    $ do
                    Reg
    _ <- Format -> NatM Reg
    getPicBaseNat forall a b. (a -> b) -> a -> b
    $ Bool -> Format
    archWordFormat Bool
    True
                    forall (m :: * -> *) a. Monad m => a -> m a
    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
    _ -> forall a. 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 ->
                                        forall a. Integral a => a -> a -> a
    roundTo Int
    16 forall a b. (a -> b) -> a -> b
    $ (Int
    24 forall a. Num a => a -> a -> a
    +) forall a b. (a -> b) -> a -> b
    $ forall a. Ord a => a -> a -> a
    max Int
    32 forall a b. (a -> b) -> a -> b
    $ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum forall a b. (a -> b) -> a -> b
    $
                                        forall a b. (a -> b) -> [a] -> [b]
    map (Width -> Int
    widthInBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmType -> Width
    typeWidth) [CmmType]
    argReps
                                    GenCCallPlatform
    GCP32ELF -> forall a. Integral a => a -> a -> a
    roundTo Int
    16 Int
    finalStack
                                    GCP64ELF Int
    1 ->
                                        forall a. Integral a => a -> a -> a
    roundTo Int
    16 forall a b. (a -> b) -> a -> b
    $ (Int
    48 forall a. Num a => a -> a -> a
    +) forall a b. (a -> b) -> a -> b
    $ forall a. Ord a => a -> a -> a
    max Int
    64 forall a b. (a -> b) -> a -> b
    $ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum forall a b. (a -> b) -> a -> b
    $
                                        forall a b. (a -> b) -> [a] -> [b]
    map (forall a. Integral a => a -> a -> a
    roundTo Int
    8 forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Width -> Int
    widthInBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmType -> Width
    typeWidth)
                                            [CmmType]
    argReps
                                    GCP64ELF Int
    2 ->
                                        forall a. Integral a => a -> a -> a
    roundTo Int
    16 forall a b. (a -> b) -> a -> b
    $ (Int
    32 forall a. Num a => a -> a -> a
    +) forall a b. (a -> b) -> a -> b
    $ forall a. Ord a => a -> a -> a
    max Int
    64 forall a b. (a -> b) -> a -> b
    $ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum forall a b. (a -> b) -> a -> b
    $
                                        forall a b. (a -> b) -> [a] -> [b]
    map (forall a. Integral a => a -> a -> a
    roundTo Int
    8 forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Width -> Int
    widthInBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmType -> Width
    typeWidth)
                                            [CmmType]
    argReps
                                    GenCCallPlatform
    _ -> forall a. String -> a
    panic String
    "genCall': unknown calling conv."

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

            roundTo :: a -> a -> a
    roundTo a
    a a
    x | a
    x forall a. Integral a => a -> a -> a
    `mod` a
    a forall a. Eq a => a -> a -> Bool
    == a
    0 = a
    x
                        | Bool
    otherwise = a
    x forall a. Num a => a -> a -> a
    + a
    a forall a. Num a => a -> a -> a
    - (a
    x 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 forall a. Ord a => a -> a -> Bool
    > Platform -> Int
    stackFrameHeaderSize Platform
    platform =
                            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 = 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 forall a. Ord a => a -> a -> Bool
    > Platform -> Int
    stackFrameHeaderSize Platform
    platform =
                            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 = 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        -> forall a. OrdList a
    nilOL
               -- See Section 3.9.4 of OpenPower ABI
               GenCCallPlatform
    GCPAIX          -> forall a. a -> OrdList a
    unitOL Instr
    NOP
               -- See Section 3.5.11 of PPC64 ELF v1.9
               GCP64ELF Int
    1      -> forall a. a -> OrdList a
    unitOL Instr
    NOP
               -- See Section 2.3.6 of PPC64 ELF v2
               GCP64ELF Int
    2      -> forall a. a -> OrdList a
    unitOL Instr
    NOP
               GenCCallPlatform
    _               -> forall a. 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 = 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
                    ChildCode64 OrdList Instr
    code Reg
    vr_lo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    arg
                    let vr_hi :: Reg
    vr_hi = Reg -> Reg
    getHiVRegFromLo Reg
    vr_lo

                    case GenCCallPlatform
    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
                                             (forall a. Int -> [a] -> [a]
    drop Int
    2 [Reg]
    gprs)
                                             [Reg]
    fprs
                                             (Int
    stackOffsetforall a. Num a => a -> a -> a
    +Int
    8)
                                             (OrdList Instr
    accumCode forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code
                                                   forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> [Reg] -> Int -> Instr
    storeWord Reg
    vr_hi [Reg]
    gprs Int
    stackOffset
                                                   forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> [Reg] -> Int -> Instr
    storeWord Reg
    vr_lo (forall a. Int -> [a] -> [a]
    drop Int
    1 [Reg]
    gprs) (Int
    stackOffsetforall a. Num a => a -> a -> a
    +Int
    4))
                                             ((forall a. Int -> [a] -> [a]
    take Int
    2 [Reg]
    gprs) forall a. [a] -> [a] -> [a]
    ++ [Reg]
    accumUsed)
                        GenCCallPlatform
    GCP32ELF ->
                            do let stackOffset' :: Int
    stackOffset' = forall a. Integral a => a -> a -> a
    roundTo Int
    8 Int
    stackOffset
                                   stackCode :: OrdList Instr
    stackCode = OrdList Instr
    accumCode forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code
                                       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'))
                                       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'forall a. Num a => a -> a -> a
    +Int
    4)))
                                   regCode :: Reg -> Reg -> OrdList Instr
    regCode Reg
    hireg Reg
    loreg =
                                       OrdList Instr
    accumCode forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code
                                           forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Instr
    MR Reg
    hireg Reg
    vr_hi
                                           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 | forall a. Integral a => a -> Bool
    even (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 forall a. a -> [a] -> [a]
    : Reg
    loreg 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 forall a. a -> [a] -> [a]
    : Reg
    loreg 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'forall a. Num a => a -> a -> a
    +Int
    8)
                                                     OrdList Instr
    stackCode [Reg]
    accumUsed
                        GCP64ELF Int
    _ -> forall a. 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
    register <- CmmExpr -> NatM Register
    getRegister CmmExpr
    arg_pro
                    let code :: OrdList Instr
    code = case Register
    register of
                                Fixed Format
    _ Reg
    freg OrdList Instr
    fcode -> OrdList Instr
    fcode 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 :: Int
    stackOffsetRes = case GenCCallPlatform
    gcp of
                                         -- The PowerOpen ABI requires that we
                                         -- reserve stack slots for register
                                         -- parameters
                                         GenCCallPlatform
    GCPAIX    -> Int
    stackOffset 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 forall a. Num a => a -> a -> a
    + Int
    stackBytes
                    [(CmmExpr, CmmType, ForeignHint)]
    -> [Reg]
    -> [Reg]
    -> Int
    -> OrdList Instr
    -> [Reg]
    -> NatM (Int, OrdList Instr, [Reg])
    passArguments [(CmmExpr, CmmType, ForeignHint)]
    args
                                  (forall a. Int -> [a] -> [a]
    drop Int
    nGprs [Reg]
    gprs)
                                  (forall a. Int -> [a] -> [a]
    drop Int
    nFprs [Reg]
    fprs)
                                  Int
    stackOffsetRes
                                  (OrdList Instr
    accumCode forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code)
                                  (Reg
    reg forall a. a -> [a] -> [a]
    : [Reg]
    accumUsed)
                | Bool
    otherwise = do
                    (Reg
    vr, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    arg_pro
                    [(CmmExpr, CmmType, ForeignHint)]
    -> [Reg]
    -> [Reg]
    -> Int
    -> OrdList Instr
    -> [Reg]
    -> NatM (Int, OrdList Instr, [Reg])
    passArguments [(CmmExpr, CmmType, ForeignHint)]
    args
                                  (forall a. Int -> [a] -> [a]
    drop Int
    nGprs [Reg]
    gprs)
                                  (forall a. Int -> [a] -> [a]
    drop Int
    nFprs [Reg]
    fprs)
                                  (Int
    stackOffset' forall a. Num a => a -> a -> a
    + Int
    stackBytes)
                                  (OrdList Instr
    accumCode forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code
                                             forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    ST Format
    format_pro Reg
    vr AddrMode
    stackSlot)
                                  [Reg]
    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 forall a. Eq a => a -> a -> Bool
    == Width
    W64 ->
                                       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 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' 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 -> forall a. 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 -> forall a. 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
                    [] -> forall a. OrdList a
    nilOL
                    [CmmFormal
    dest]
                        | Bool
    reduceToFF32 Bool -> Bool -> Bool
    && CmmType -> Bool
    isFloat32 CmmType
    rep   -> 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 -> 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
                           -> 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 -> forall a. a -> OrdList a
    unitOL (Reg -> Reg -> Instr
    MR Reg
    r_dest Reg
    r3)
                        where rep :: CmmType
    rep = Platform -> CmmReg -> CmmType
    cmmRegType Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dest)
                              r_dest :: Reg
    r_dest = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dest)
                    [CmmFormal]
    _ -> forall a. String -> a
    panic String
    "genCCall' moveResult: Bad dest_regs"

            outOfLineMachOp :: CallishMachOp -> NatM (Either CLabel CmmExpr, Bool)
    outOfLineMachOp CallishMachOp
    mop =
                do
                    CmmExpr
    mopExpr <- forall (m :: * -> *).
    CmmMakeDynamicReferenceM m =>
    NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
    cmmMakeDynamicReference NCGConfig
    config ReferenceKind
    CallReference forall a b. (a -> b) -> a -> b
    $
                                  FastString
    -> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
    mkForeignLabel FastString
    functionName forall a. Maybe a
    Nothing ForeignLabelSource
    ForeignLabelInThisPackage FunctionOrData
    IsFunction
                    let mopLabelOrExpr :: Either CLabel CmmExpr
    mopLabelOrExpr = case CmmExpr
    mopExpr of
                            CmmLit (CmmLabel CLabel
    lbl) -> forall a b. a -> Either a b
    Left CLabel
    lbl
                            CmmExpr
    _ -> forall a b. b -> Either a b
    Right CmmExpr
    mopExpr
                    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either CLabel CmmExpr
    mopLabelOrExpr, Bool
    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 -> (String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    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)

                        MO_BSwap Width
    w   -> (String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    bSwapLabel Width
    w, Bool
    False)
                        MO_BRev Width
    w    -> (String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    bRevLabel Width
    w, Bool
    False)
                        MO_PopCnt Width
    w  -> (String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    popCntLabel Width
    w, Bool
    False)
                        MO_Pdep Width
    w    -> (String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    pdepLabel Width
    w, Bool
    False)
                        MO_Pext Width
    w    -> (String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    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 -> (String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    cmpxchgLabel Width
    w, Bool
    False)
                        MO_Xchg Width
    w    -> (String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    xchgLabel Width
    w, Bool
    False)
                        MO_AtomicRead Width
    _  -> (FastString, Bool)
    unsupported
                        MO_AtomicWrite Width
    _ -> (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_ReadBarrier   -> (FastString, Bool)
    unsupported
                        CallishMachOp
    MO_WriteBarrier  -> (FastString, Bool)
    unsupported
                        CallishMachOp
    MO_Touch         -> (FastString, Bool)
    unsupported
                        MO_Prefetch_Data Int
    _ -> (FastString, Bool)
    unsupported
                    unsupported :: (FastString, Bool)
    unsupported = forall a. String -> a
    panic (String
    "outOfLineCmmOp: " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show CallishMachOp
    mop
                                      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
    reg,OrdList Instr
    e_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffset Platform
    platform CmmExpr
    expr Int
    offset)
            let fmt :: Format
    fmt = Bool -> Format
    archWordFormat forall a b. (a -> b) -> a -> b
    $ Platform -> Bool
    target32Bit Platform
    platform
                sha :: Int
    sha = if Platform -> Bool
    target32Bit Platform
    platform then Int
    2 else Int
    3
            Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    fmt
            CLabel
    lbl <- NatM CLabel
    getNewLabelNat
            CmmExpr
    dynRef <- forall (m :: * -> *).
    CmmMakeDynamicReferenceM m =>
    NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
    cmmMakeDynamicReference NCGConfig
    config ReferenceKind
    DataReference CLabel
    lbl
            (Reg
    tableReg,OrdList Instr
    t_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg forall a b. (a -> b) -> a -> b
    $ CmmExpr
    dynRef
            let code :: OrdList Instr
    code = OrdList Instr
    e_code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    t_code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` 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 (forall a. a -> Maybe a
    Just CLabel
    lbl) []
                        ]
            forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    code

      | (NCGConfig -> Bool
    ncgPIC NCGConfig
    config) Bool -> Bool -> Bool
    || (Bool -> Bool
    not forall a b. (a -> b) -> a -> b
    $ Platform -> Bool
    target32Bit Platform
    platform)
      = do
            (Reg
    reg,OrdList Instr
    e_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffset Platform
    platform CmmExpr
    expr Int
    offset)
            let fmt :: Format
    fmt = Bool -> Format
    archWordFormat forall a b. (a -> b) -> a -> b
    $ Platform -> Bool
    target32Bit Platform
    platform
                sha :: Int
    sha = if Platform -> Bool
    target32Bit Platform
    platform then Int
    2 else Int
    3
            Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    fmt
            CLabel
    lbl <- NatM CLabel
    getNewLabelNat
            CmmExpr
    dynRef <- forall (m :: * -> *).
    CmmMakeDynamicReferenceM m =>
    NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
    cmmMakeDynamicReference NCGConfig
    config ReferenceKind
    DataReference CLabel
    lbl
            (Reg
    tableReg,OrdList Instr
    t_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg forall a b. (a -> b) -> a -> b
    $ CmmExpr
    dynRef
            let code :: OrdList Instr
    code = OrdList Instr
    e_code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    t_code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` 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 (forall a. a -> Maybe a
    Just CLabel
    lbl) []
                        ]
            forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    code
      | Bool
    otherwise
      = do
            (Reg
    reg,OrdList Instr
    e_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffset Platform
    platform CmmExpr
    expr Int
    offset)
            let fmt :: Format
    fmt = Bool -> Format
    archWordFormat forall a b. (a -> b) -> a -> b
    $ Platform -> Bool
    target32Bit Platform
    platform
                sha :: Int
    sha = if Platform -> Bool
    target32Bit Platform
    platform then Int
    2 else Int
    3
            Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    fmt
            CLabel
    lbl <- NatM CLabel
    getNewLabelNat
            let code :: OrdList Instr
    code = OrdList Instr
    e_code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` 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 (forall a. a -> Maybe a
    Just CLabel
    lbl) []
                        ]
            forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Instr
    code
      where
        (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 forall a b. (a -> b) -> a -> b
    $ Platform -> Bool
    target32Bit forall a b. (a -> b) -> a -> b
    $ NCGConfig -> Platform
    ncgPlatform NCGConfig
    config)
                = forall a b. (a -> b) -> [a] -> [b]
    map Maybe BlockId -> CmmStatic
    jumpTableEntryRel [Maybe BlockId]
    ids
                | Bool
    otherwise = 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 forall a. a -> Maybe a
    Just (forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData (SectionType -> CLabel -> Section
    Section SectionType
    ReadOnlyData CLabel
    lbl) (forall (a :: Bool). CLabel -> [CmmStatic] -> GenCmmStatics a
    CmmStaticsRaw CLabel
    lbl [CmmStatic]
    jumpTable))
    generateJumpTableForInstr NCGConfig
    _ 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 Bool
    _ Cond
    cond OrdList Instr
    cond_code <- NatM CondCode
    getCond
        Platform
    platform <- NatM Platform
    getPlatform
        let
            code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    cond_code
                forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    negate_code
                forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` forall a. [a] -> OrdList a
    toOL [
                    Reg -> Instr
    MFCR Reg
    dst,
                    Reg -> Reg -> Int -> Int -> Int -> Instr
    RLWINM Reg
    dst Reg
    dst (Int
    bit forall a. Num a => a -> a -> a
    + Int
    1) Int
    31 Int
    31
                ]

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

            (Int
    bit, Bool
    do_negate) = case Cond
    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
    _   -> forall a. String -> a
    panic String
    "PPC.CodeGen.codeReg: no match"

            format :: Format
    format = Bool -> Format
    archWordFormat forall a b. (a -> b) -> a -> b
    $ Platform -> Bool
    target32Bit Platform
    platform
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format Reg -> OrdList Instr
    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 <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    rep Bool
    signed Integer
    y
        = do
            (Reg
    src1, OrdList Instr
    code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
            let code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    code1 forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> RI -> Instr
    instr Reg
    dst Reg
    src1 (Imm -> RI
    RIImm Imm
    imm)
            forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    rep) Reg -> OrdList Instr
    code)

    trivialCode Width
    rep Bool
    _ Reg -> Reg -> RI -> Instr
    instr CmmExpr
    x CmmExpr
    y = do
        (Reg
    src1, OrdList Instr
    code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
        (Reg
    src2, OrdList Instr
    code2) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    y
        let code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    code1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code2 forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> RI -> Instr
    instr Reg
    dst Reg
    src1 (Reg -> RI
    RIReg Reg
    src2)
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    rep) Reg -> OrdList Instr
    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 <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    width Bool
    sign Integer
    y
        = do
            (Reg
    src1, OrdList Instr
    code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
            let format :: Format
    format = Width -> Format
    intFormat Width
    width
            let ins_fmt :: Format
    ins_fmt = Width -> Format
    intFormat (forall a. Ord a => a -> a -> a
    max Width
    W32 Width
    width)
            let code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    code1 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)
            forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format Reg -> OrdList Instr
    code)

    shiftMulCode Width
    width Bool
    _ Format -> Reg -> Reg -> RI -> Instr
    instr CmmExpr
    x CmmExpr
    y = do
        (Reg
    src1, OrdList Instr
    code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
        (Reg
    src2, OrdList Instr
    code2) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    y
        let format :: Format
    format = Width -> Format
    intFormat Width
    width
        let ins_fmt :: Format
    ins_fmt = Width -> Format
    intFormat (forall a. Ord a => a -> a -> a
    max Width
    W32 Width
    width)
        let code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    code1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code2
                       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)
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format Reg -> OrdList Instr
    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
        (Reg
    src1, OrdList Instr
    code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
        (Reg
    src2, OrdList Instr
    code2) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    y
        let code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    code1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code2 forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Reg -> Instr
    instr Reg
    dst Reg
    src1 Reg
    src2
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    format Reg -> OrdList Instr
    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 <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    width Bool
    sgn Integer
    y
        = do
            let op_len :: Width
    op_len = 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
            (Reg
    src1, OrdList Instr
    code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
    extend Width
    width Width
    op_len CmmExpr
    x)
            let code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    code1 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)
            forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    width) Reg -> OrdList Instr
    code)

    srCode Width
    width Bool
    sgn Format -> Reg -> Reg -> RI -> Instr
    instr CmmExpr
    x CmmExpr
    y = do
      let op_len :: Width
    op_len = 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
      (Reg
    src1, OrdList Instr
    code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
    extend Width
    width Width
    op_len CmmExpr
    x)
      (Reg
    src2, OrdList Instr
    code2) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
    extendUExpr Width
    width Width
    op_len CmmExpr
    y)
      -- Note: Shift amount `y` is unsigned
      let code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    code1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code2 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)
      forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    width) Reg -> OrdList Instr
    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 = 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
      (Reg
    src1, OrdList Instr
    code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
    extend Width
    width Width
    op_len CmmExpr
    x)
      (Reg
    src2, OrdList Instr
    code2) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
    extend Width
    width Width
    op_len CmmExpr
    y)
      let code :: Reg -> OrdList Instr
    code Reg
    dst = OrdList Instr
    code1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    code2 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
      forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    width) Reg -> OrdList Instr
    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
        (Reg
    src, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
        let code' :: Reg -> OrdList Instr
    code' Reg
    dst = OrdList Instr
    code forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Instr
    instr Reg
    dst Reg
    src
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any Format
    rep Reg -> OrdList Instr
    code')

    -- 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 = 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
      (Reg
    x_reg, OrdList Instr
    x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
    extend Width
    rep Width
    op_len CmmExpr
    arg_x)
      (Reg
    y_reg, OrdList Instr
    y_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
    extend Width
    rep Width
    op_len CmmExpr
    arg_y)
      forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ \Reg
    reg_r -> OrdList Instr
    y_code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    x_code
                         forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` 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
    platform <- NatM Platform
    getPlatform
        let arch :: Arch
    arch = Platform -> Arch
    platformArch Platform
    platform
        Arch -> Width -> Width -> CmmExpr -> NatM Register
    coerceInt2FP' Arch
    arch Width
    fromRep Width
    toRep CmmExpr
    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
        (Reg
    src, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
        CLabel
    lbl <- NatM CLabel
    getNewLabelNat
        Reg
    itmp <- Format -> NatM Reg
    getNewRegNat Format
    II32
        Reg
    ftmp <- Format -> NatM Reg
    getNewRegNat Format
    FF64
        NCGConfig
    config <- NatM NCGConfig
    getConfig
        Platform
    platform <- NatM Platform
    getPlatform
        CmmExpr
    dynRef <- forall (m :: * -> *).
    CmmMakeDynamicReferenceM m =>
    NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
    cmmMakeDynamicReference NCGConfig
    config ReferenceKind
    DataReference CLabel
    lbl
        Amode AddrMode
    addr OrdList Instr
    addr_code <- InstrForm -> CmmExpr -> NatM Amode
    getAmode InstrForm
    D CmmExpr
    dynRef
        let
            code' :: Reg -> OrdList Instr
    code' Reg
    dst = OrdList Instr
    code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    maybe_exts forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` forall a. [a] -> OrdList a
    toOL [
                    Section -> RawCmmStatics -> Instr
    LDATA (SectionType -> CLabel -> Section
    Section SectionType
    ReadOnlyData CLabel
    lbl) forall a b. (a -> b) -> a -> b
    $ forall (a :: Bool). CLabel -> [CmmStatic] -> GenCmmStatics a
    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)
                ] forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    addr_code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` 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
                ] forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> OrdList Instr
    maybe_frsp Reg
    dst

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

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

        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    floatFormat Width
    toRep) Reg -> OrdList Instr
    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
        (Reg
    src, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
        Platform
    platform <- NatM Platform
    getPlatform
        Reg
    upper <- Format -> NatM Reg
    getNewRegNat Format
    II64
        Reg
    lower <- Format -> NatM Reg
    getNewRegNat Format
    II64
        BlockId
    l1 <- NatM BlockId
    getBlockIdNat
        BlockId
    l2 <- NatM BlockId
    getBlockIdNat
        let
            code' :: Reg -> OrdList Instr
    code' Reg
    dst = OrdList Instr
    code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Instr
    maybe_exts forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` 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
                ] forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Reg -> OrdList Instr
    maybe_frsp Reg
    dst

            maybe_exts :: OrdList Instr
    maybe_exts
              = case Width
    fromRep of
                  Width
    W8 ->  forall a. a -> OrdList a
    unitOL forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> Reg -> Instr
    EXTS Format
    II8 Reg
    src Reg
    src
                  Width
    W16 -> forall a. a -> OrdList a
    unitOL forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> Reg -> Instr
    EXTS Format
    II16 Reg
    src Reg
    src
                  Width
    W32 -> forall a. a -> OrdList a
    unitOL 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 -> 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 forall a. Maybe a
    Nothing
                                        , Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    l1 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 forall a. Maybe a
    Nothing
                                        , BlockId -> Instr
    NEWBLOCK BlockId
    l2
                                        ]
                            Width
    _   -> forall a. OrdList a
    nilOL
                  Width
    _       -> forall a. String -> a
    panic String
    "PPC.CodeGen.coerceInt2FP: no match"

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

        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    floatFormat Width
    toRep) Reg -> OrdList Instr
    code')

    coerceInt2FP' Arch
    _ Width
    _ Width
    _ CmmExpr
    _ = forall a. 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
    platform <- NatM Platform
    getPlatform
        let arch :: Arch
    arch =  Platform -> Arch
    platformArch Platform
    platform
        Arch -> Width -> Width -> CmmExpr -> NatM Register
    coerceFP2Int' Arch
    arch Width
    fromRep Width
    toRep CmmExpr
    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
    platform <- NatM Platform
    getPlatform
        -- the reps don't really matter: F*->FF64 and II32->I* are no-ops
        (Reg
    src, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
        Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    FF64
        let
            code' :: Reg -> OrdList Instr
    code' Reg
    dst = OrdList Instr
    code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` 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)]
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    toRep) Reg -> OrdList Instr
    code')

    coerceFP2Int' (ArchPPC_64 PPC_64ABI
    _) Width
    _ Width
    toRep CmmExpr
    x = do
        Platform
    platform <- NatM Platform
    getPlatform
        -- the reps don't really matter: F*->FF64 and II64->I* are no-ops
        (Reg
    src, OrdList Instr
    code) <- CmmExpr -> NatM (Reg, OrdList Instr)
    getSomeReg CmmExpr
    x
        Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    FF64
        let
            code' :: Reg -> OrdList Instr
    code' Reg
    dst = OrdList Instr
    code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` 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)]
        forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> OrdList Instr) -> Register
    Any (Width -> Format
    intFormat Width
    toRep) Reg -> OrdList Instr
    code')

    coerceFP2Int' Arch
    _ Width
    _ Width
    _ CmmExpr
    _ = forall a. 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