    {-# LANGUAGE CPP #-}

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

    {-# LANGUAGE GADTs #-}
    module GHC.CmmToAsm.SPARC.CodeGen (
            cmmTopCodeGen,
            generateJumpTableForInstr,
            InstrBlock
    )

    where

    #include "HsVersions.h"

    -- NCG stuff:
    import GHC.Prelude

    import GHC.CmmToAsm.SPARC.Base
    import GHC.CmmToAsm.SPARC.CodeGen.Sanity
    import GHC.CmmToAsm.SPARC.CodeGen.Amode
    import GHC.CmmToAsm.SPARC.CodeGen.CondCode
    import GHC.CmmToAsm.SPARC.CodeGen.Gen64
    import GHC.CmmToAsm.SPARC.CodeGen.Gen32
    import GHC.CmmToAsm.SPARC.CodeGen.Base
    import GHC.CmmToAsm.SPARC.Instr
    import GHC.CmmToAsm.SPARC.Imm
    import GHC.CmmToAsm.SPARC.AddrMode
    import GHC.CmmToAsm.SPARC.Regs
    import GHC.CmmToAsm.SPARC.Stack
    import GHC.CmmToAsm.Types
    import GHC.CmmToAsm.Format
    import GHC.CmmToAsm.Monad   ( NatM, getNewRegNat, getNewLabelNat, getPlatform, getConfig )
    import GHC.CmmToAsm.Config

    -- Our intermediate code:
    import GHC.Cmm.BlockId
    import GHC.Cmm
    import GHC.Cmm.Utils
    import GHC.Cmm.Switch
    import GHC.Cmm.Dataflow.Block
    import GHC.Cmm.Dataflow.Graph
    import GHC.CmmToAsm.PIC
    import GHC.Platform.Reg
    import GHC.Cmm.CLabel
    import GHC.CmmToAsm.CPrim

    -- The rest:
    import GHC.Types.Basic
    import GHC.Data.FastString
    import GHC.Data.OrdList
    import GHC.Utils.Panic
    import GHC.Platform

    import Control.Monad    ( mapAndUnzipM )

    -- | Top level code generation
    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

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

          forall (m :: * -> *) a. Monad m => a -> m a
    return [NatCmmDecl RawCmmStatics Instr]
    tops

    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

    -- | Do code generation on a single block of CMM code.
    --      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.
    basicBlockCodeGen :: CmmBlock
                      -> 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 :: Label
    id = forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    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
      Platform
    platform <- NatM Platform
    getPlatform
      InstrBlock
    mid_instrs <- forall (e :: Extensibility) (x :: Extensibility).
    [CmmNode e x] -> NatM InstrBlock
    stmtsToInstrs [CmmNode O O]
    stmts
      InstrBlock
    tail_instrs <- forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> NatM InstrBlock
    stmtToInstrs CmmNode O C
    tail
      let instrs :: InstrBlock
    instrs = InstrBlock
    mid_instrs forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` InstrBlock
    tail_instrs
      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 ([],[],[]) InstrBlock
    instrs

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

            -- do intra-block sanity checking
            blocksChecked :: [NatBasicBlock Instr]
    blocksChecked
                    = forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CmmBlock -> NatBasicBlock Instr -> NatBasicBlock Instr
    checkBlock Platform
    platform CmmBlock
    block)
                    forall a b. (a -> b) -> a -> b
    $ forall i. Label -> [i] -> GenBasicBlock i
    BasicBlock Label
    id [Instr]
    top forall a. a -> [a] -> [a]
    : [NatBasicBlock Instr]
    other_blocks

      forall (m :: * -> *) a. Monad m => a -> m a
    return ([NatBasicBlock Instr]
    blocksChecked, [NatCmmDecl RawCmmStatics Instr]
    statics)

    -- | Convert some Cmm statements to SPARC instructions.
    stmtsToInstrs :: [CmmNode e x] -> NatM InstrBlock
    stmtsToInstrs :: forall (e :: Extensibility) (x :: Extensibility).
    [CmmNode e x] -> NatM InstrBlock
    stmtsToInstrs [CmmNode e x]
    stmts
       = do [InstrBlock]
    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 InstrBlock
    stmtToInstrs [CmmNode e x]
    stmts
            forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. [OrdList a] -> OrdList a
    concatOL [InstrBlock]
    instrss)

    stmtToInstrs :: CmmNode e x -> NatM InstrBlock
    stmtToInstrs :: forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> NatM InstrBlock
    stmtToInstrs CmmNode e x
    stmt = do
      Platform
    platform <- NatM Platform
    getPlatform
      NCGConfig
    config <- NatM NCGConfig
    getConfig
      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 InstrBlock
    assignReg_FltCode Format
    format CmmReg
    reg CmmExpr
    src
          | CmmType -> Bool
    isWord64 CmmType
    ty     -> CmmReg -> CmmExpr -> NatM InstrBlock
    assignReg_I64Code        CmmReg
    reg CmmExpr
    src
          | Bool
    otherwise       -> Format -> CmmReg -> CmmExpr -> NatM InstrBlock
    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
    _
          | CmmType -> Bool
    isFloatType CmmType
    ty  -> Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
    assignMem_FltCode Format
    format CmmExpr
    addr CmmExpr
    src
          | CmmType -> Bool
    isWord64 CmmType
    ty     -> CmmExpr -> CmmExpr -> NatM InstrBlock
    assignMem_I64Code      CmmExpr
    addr CmmExpr
    src
          | Bool
    otherwise       -> Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
    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 InstrBlock
    genCCall ForeignTarget
    target [CmmFormal]
    result_regs [CmmExpr]
    args

        CmmBranch   Label
    id              -> Label -> NatM InstrBlock
    genBranch Label
    id
        CmmCondBranch CmmExpr
    arg Label
    true Label
    false Maybe Bool
    _ -> do
          InstrBlock
    b1 <- Label -> CmmExpr -> NatM InstrBlock
    genCondJump Label
    true CmmExpr
    arg
          InstrBlock
    b2 <- Label -> NatM InstrBlock
    genBranch Label
    false
          forall (m :: * -> *) a. Monad m => a -> m a
    return (InstrBlock
    b1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` InstrBlock
    b2)
        CmmSwitch CmmExpr
    arg SwitchTargets
    ids   -> NCGConfig -> CmmExpr -> SwitchTargets -> NatM InstrBlock
    genSwitch NCGConfig
    config CmmExpr
    arg SwitchTargets
    ids
        CmmCall { cml_target :: CmmNode O C -> CmmExpr
    cml_target = CmmExpr
    arg } -> CmmExpr -> NatM InstrBlock
    genJump CmmExpr
    arg

        CmmNode e x
    _
         -> forall a. String -> a
    panic String
    "stmtToInstrs: statement should have been cps'd away"

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

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

    -- -----------------------------------------------------------------------------
    -- 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
    assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
    assignMem_IntCode Format
    pk CmmExpr
    addr CmmExpr
    src = do
        (Reg
    srcReg, InstrBlock
    code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    src
        Amode AddrMode
    dstAddr InstrBlock
    addr_code <- CmmExpr -> NatM Amode
    getAmode CmmExpr
    addr
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ InstrBlock
    code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` InstrBlock
    addr_code forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> AddrMode -> Instr
    ST Format
    pk Reg
    srcReg AddrMode
    dstAddr

    assignReg_IntCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock
    assignReg_IntCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock
    assignReg_IntCode Format
    _ CmmReg
    reg CmmExpr
    src = do
        Platform
    platform <- NatM Platform
    getPlatform
        Register
    r <- CmmExpr -> NatM Register
    getRegister CmmExpr
    src
        let dst :: Reg
    dst = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform CmmReg
    reg
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ case Register
    r of
            Any Format
    _ Reg -> InstrBlock
    code         -> Reg -> InstrBlock
    code Reg
    dst
            Fixed Format
    _ Reg
    freg InstrBlock
    fcode -> InstrBlock
    fcode forall a. OrdList a -> a -> OrdList a
    `snocOL` Bool -> Reg -> RI -> Reg -> Instr
    OR Bool
    False Reg
    g0 (Reg -> RI
    RIReg Reg
    freg) Reg
    dst

    -- Floating point assignment to memory
    assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
    assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
    assignMem_FltCode Format
    pk CmmExpr
    addr CmmExpr
    src = do
        Platform
    platform <- NatM Platform
    getPlatform
        Amode AddrMode
    dst__2 InstrBlock
    code1 <- CmmExpr -> NatM Amode
    getAmode CmmExpr
    addr
        (Reg
    src__2, InstrBlock
    code2) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    src
        Reg
    tmp1 <- Format -> NatM Reg
    getNewRegNat Format
    pk
        let
            pk__2 :: CmmType
    pk__2   = Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    src
            code__2 :: InstrBlock
    code__2 = InstrBlock
    code1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` InstrBlock
    code2 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                if   Format -> Width
    formatToWidth Format
    pk forall a. Eq a => a -> a -> Bool
    == CmmType -> Width
    typeWidth CmmType
    pk__2
                then forall a. a -> OrdList a
    unitOL (Format -> Reg -> AddrMode -> Instr
    ST Format
    pk Reg
    src__2 AddrMode
    dst__2)
                else forall a. [a] -> OrdList a
    toOL   [ Format -> Format -> Reg -> Reg -> Instr
    FxTOy (CmmType -> Format
    cmmTypeFormat CmmType
    pk__2) Format
    pk Reg
    src__2 Reg
    tmp1
                            , Format -> Reg -> AddrMode -> Instr
    ST    Format
    pk Reg
    tmp1 AddrMode
    dst__2]
        forall (m :: * -> *) a. Monad m => a -> m a
    return InstrBlock
    code__2

    -- Floating point assignment to a register/temporary
    assignReg_FltCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock
    assignReg_FltCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock
    assignReg_FltCode Format
    pk CmmReg
    dstCmmReg CmmExpr
    srcCmmExpr = do
        Platform
    platform <- NatM Platform
    getPlatform
        Register
    srcRegister <- CmmExpr -> NatM Register
    getRegister CmmExpr
    srcCmmExpr
        let dstReg :: Reg
    dstReg  = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform CmmReg
    dstCmmReg

        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ case Register
    srcRegister of
            Any Format
    _ Reg -> InstrBlock
    code                  -> Reg -> InstrBlock
    code Reg
    dstReg
            Fixed Format
    _ Reg
    srcFixedReg InstrBlock
    srcCode -> InstrBlock
    srcCode forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Reg -> Reg -> Instr
    FMOV Format
    pk Reg
    srcFixedReg Reg
    dstReg

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

    genJump :: CmmExpr -> NatM InstrBlock
    genJump (CmmLit (CmmLabel CLabel
    lbl))
      = forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. [a] -> OrdList a
    toOL [Either Imm Reg -> Int -> Bool -> Instr
    CALL (forall a b. a -> Either a b
    Left Imm
    target) Int
    0 Bool
    True, Instr
    NOP])
      where
        target :: Imm
    target = CLabel -> Imm
    ImmCLbl CLabel
    lbl

    genJump CmmExpr
    tree
      = do
            (Reg
    target, InstrBlock
    code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    tree
            forall (m :: * -> *) a. Monad m => a -> m a
    return (InstrBlock
    code forall a. OrdList a -> a -> OrdList a
    `snocOL` AddrMode -> Instr
    JMP (Reg -> Reg -> AddrMode
    AddrRegReg Reg
    target Reg
    g0)  forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    NOP)

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

    genBranch :: BlockId -> NatM InstrBlock
    genBranch :: Label -> NatM InstrBlock
    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
    . Label -> [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.

    SPARC: First, we have to ensure that the condition codes are set
    according to the supplied comparison operation.  We generate slightly
    different code for floating point comparisons, because a floating
    point operation cannot directly precede a @BF@.  We assume the worst
    and fill that slot with a @NOP@.

    SPARC: Do not fill the delay slots here; you will confuse the register
    allocator.
    -}

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

    genCondJump :: Label -> CmmExpr -> NatM InstrBlock
    genCondJump Label
    bid CmmExpr
    bool = do
      CondCode Bool
    is_float Cond
    cond InstrBlock
    code <- CmmExpr -> NatM CondCode
    getCondCode CmmExpr
    bool
      forall (m :: * -> *) a. Monad m => a -> m a
    return (
           InstrBlock
    code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
           forall a. [a] -> OrdList a
    toOL (
             if   Bool
    is_float
             then [Instr
    NOP, Cond -> Bool -> Label -> Instr
    BF Cond
    cond Bool
    False Label
    bid, Instr
    NOP]
             else [Cond -> Bool -> Label -> Instr
    BI Cond
    cond Bool
    False Label
    bid, Instr
    NOP]
           )
        )

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

    genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM InstrBlock
    genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM InstrBlock
    genSwitch NCGConfig
    config CmmExpr
    expr SwitchTargets
    targets
            | NCGConfig -> Bool
    ncgPIC NCGConfig
    config
            = forall a. HasCallStack => String -> a
    error String
    "MachCodeGen: sparc genSwitch PIC not finished\n"

            | Bool
    otherwise
            = do    (Reg
    e_reg, InstrBlock
    e_code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg (Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffset (NCGConfig -> Platform
    ncgPlatform NCGConfig
    config) CmmExpr
    expr Int
    offset)

                    Reg
    base_reg        <- Format -> NatM Reg
    getNewRegNat Format
    II32
                    Reg
    offset_reg      <- Format -> NatM Reg
    getNewRegNat Format
    II32
                    Reg
    dst             <- Format -> NatM Reg
    getNewRegNat Format
    II32

                    CLabel
    label           <- NatM CLabel
    getNewLabelNat

                    forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ InstrBlock
    e_code forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                     forall a. [a] -> OrdList a
    toOL
                            [ -- load base of jump table
                              Imm -> Reg -> Instr
    SETHI (Imm -> Imm
    HI (CLabel -> Imm
    ImmCLbl CLabel
    label)) Reg
    base_reg
                            , Bool -> Reg -> RI -> Reg -> Instr
    OR    Bool
    False Reg
    base_reg (Imm -> RI
    RIImm forall a b. (a -> b) -> a -> b
    $ Imm -> Imm
    LO forall a b. (a -> b) -> a -> b
    $ CLabel -> Imm
    ImmCLbl CLabel
    label) Reg
    base_reg

                            -- the addrs in the table are 32 bits wide..
                            , Reg -> RI -> Reg -> Instr
    SLL   Reg
    e_reg (Imm -> RI
    RIImm forall a b. (a -> b) -> a -> b
    $ Int -> Imm
    ImmInt Int
    2) Reg
    offset_reg

                            -- load and jump to the destination
                            , Format -> AddrMode -> Reg -> Instr
    LD      Format
    II32 (Reg -> Reg -> AddrMode
    AddrRegReg Reg
    base_reg Reg
    offset_reg) Reg
    dst
                            , AddrMode -> [Maybe Label] -> CLabel -> Instr
    JMP_TBL (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    dst (Int -> Imm
    ImmInt Int
    0)) [Maybe Label]
    ids CLabel
    label
                            , Instr
    NOP ]
      where (Int
    offset, [Maybe Label]
    ids) = SwitchTargets -> (Int, [Maybe Label])
    switchTargetsToTable SwitchTargets
    targets

    generateJumpTableForInstr :: Platform -> Instr
                              -> Maybe (NatCmmDecl RawCmmStatics Instr)
    generateJumpTableForInstr :: Platform -> Instr -> Maybe (NatCmmDecl RawCmmStatics Instr)
    generateJumpTableForInstr Platform
    platform (JMP_TBL AddrMode
    _ [Maybe Label]
    ids CLabel
    label) =
      let jumpTable :: [CmmStatic]
    jumpTable = forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> Maybe Label -> CmmStatic
    jumpTableEntry Platform
    platform) [Maybe Label]
    ids
      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
    label) (forall (a :: Bool). CLabel -> [CmmStatic] -> GenCmmStatics a
    CmmStaticsRaw CLabel
    label [CmmStatic]
    jumpTable))
    generateJumpTableForInstr Platform
    _ Instr
    _ = forall a. Maybe a
    Nothing

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

       The SPARC calling convention is an absolute
       nightmare.  The first 6x32 bits of arguments are mapped into
       %o0 through %o5, and the remaining arguments are dumped to the
       stack, beginning at [%sp+92].  (Note that %o6 == %sp.)

       If we have to put args on the stack, move %o6==%sp down by
       the number of words to go on the stack, to ensure there's enough space.

       According to Fraser and Hanson's lcc book, page 478, fig 17.2,
       16 words above the stack pointer is a word for the address of
       a structure return value.  I use this as a temporary location
       for moving values from float to int regs.  Certainly it isn't
       safe to put anything in the 16 words starting at %sp, since
       this area can get trashed at any time due to window overflows
       caused by signal handlers.

       A final complication (if the above isn't enough) is that
       we can't blithely calculate the arguments one by one into
       %o0 .. %o5.  Consider the following nested calls:

           fff a (fff b c)

       Naive code moves a into %o0, and (fff b c) into %o1.  Unfortunately
       the inner call will itself use %o0, which trashes the value put there
       in preparation for the outer call.  Upshot: we need to calculate the
       args into temporary regs, and move those to arg regs or onto the
       stack only immediately prior to the call proper.  Sigh.
    -}

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

    -- On SPARC under TSO (Total Store Ordering), writes earlier in the instruction stream
    -- are guaranteed to take place before writes afterwards (unlike on PowerPC).
    -- Ref: Section 8.4 of the SPARC V9 Architecture manual.
    --
    -- In the SPARC case we don't need a barrier.
    --
    genCCall :: ForeignTarget -> [CmmFormal] -> [CmmExpr] -> NatM InstrBlock
    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. OrdList a
    nilOL
    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. 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 ForeignTarget
    target [CmmFormal]
    dest_regs [CmmExpr]
    args
     = do   -- work out the arguments, and assign them to integer regs
            [(InstrBlock, [Reg])]
    argcode_and_vregs       <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM CmmExpr -> NatM (InstrBlock, [Reg])
    arg_to_int_vregs [CmmExpr]
    args
            let ([InstrBlock]
    argcodes, [[Reg]]
    vregss)  = forall a b. [(a, b)] -> ([a], [b])
    unzip [(InstrBlock, [Reg])]
    argcode_and_vregs
            let vregs :: [Reg]
    vregs               = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Reg]]
    vregss

            let n_argRegs :: Int
    n_argRegs           = forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Reg]
    allArgRegs
            let n_argRegs_used :: Int
    n_argRegs_used      = forall a. Ord a => a -> a -> a
    min (forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Reg]
    vregs) Int
    n_argRegs

            -- deal with static vs dynamic call targets
            InstrBlock
    callinsns <- case ForeignTarget
    target of
                    ForeignTarget (CmmLit (CmmLabel CLabel
    lbl)) ForeignConvention
    _ ->
                            forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. a -> OrdList a
    unitOL (Either Imm Reg -> Int -> Bool -> Instr
    CALL (forall a b. a -> Either a b
    Left (CmmLit -> Imm
    litToImm (CLabel -> CmmLit
    CmmLabel CLabel
    lbl))) Int
    n_argRegs_used Bool
    False))

                    ForeignTarget CmmExpr
    expr ForeignConvention
    _
                     -> do  (InstrBlock
    dyn_c, [Reg]
    dyn_rs) <- CmmExpr -> NatM (InstrBlock, [Reg])
    arg_to_int_vregs CmmExpr
    expr
                            let dyn_r :: Reg
    dyn_r = case [Reg]
    dyn_rs of
                                          [Reg
    dyn_r'] -> Reg
    dyn_r'
                                          [Reg]
    _ -> forall a. String -> a
    panic String
    "SPARC.CodeGen.genCCall: arg_to_int"
                            forall (m :: * -> *) a. Monad m => a -> m a
    return (InstrBlock
    dyn_c forall a. OrdList a -> a -> OrdList a
    `snocOL` Either Imm Reg -> Int -> Bool -> Instr
    CALL (forall a b. b -> Either a b
    Right Reg
    dyn_r) Int
    n_argRegs_used Bool
    False)

                    PrimTarget CallishMachOp
    mop
                     -> do  Either CLabel CmmExpr
    res     <- CallishMachOp -> NatM (Either CLabel CmmExpr)
    outOfLineMachOp CallishMachOp
    mop
                            case Either CLabel CmmExpr
    res of
                                    Left CLabel
    lbl ->
                                            forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. a -> OrdList a
    unitOL (Either Imm Reg -> Int -> Bool -> Instr
    CALL (forall a b. a -> Either a b
    Left (CmmLit -> Imm
    litToImm (CLabel -> CmmLit
    CmmLabel CLabel
    lbl))) Int
    n_argRegs_used Bool
    False))

                                    Right CmmExpr
    mopExpr -> do
                                            (InstrBlock
    dyn_c, [Reg]
    dyn_rs) <- CmmExpr -> NatM (InstrBlock, [Reg])
    arg_to_int_vregs CmmExpr
    mopExpr
                                            let dyn_r :: Reg
    dyn_r = case [Reg]
    dyn_rs of
                                                          [Reg
    dyn_r'] -> Reg
    dyn_r'
                                                          [Reg]
    _ -> forall a. String -> a
    panic String
    "SPARC.CodeGen.genCCall: arg_to_int"
                                            forall (m :: * -> *) a. Monad m => a -> m a
    return (InstrBlock
    dyn_c forall a. OrdList a -> a -> OrdList a
    `snocOL` Either Imm Reg -> Int -> Bool -> Instr
    CALL (forall a b. b -> Either a b
    Right Reg
    dyn_r) Int
    n_argRegs_used Bool
    False)

            let argcode :: InstrBlock
    argcode = forall a. [OrdList a] -> OrdList a
    concatOL [InstrBlock]
    argcodes

            let (InstrBlock
    move_sp_down, InstrBlock
    move_sp_up)
                       = let diff :: Int
    diff = forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Reg]
    vregs forall a. Num a => a -> a -> a
    - Int
    n_argRegs
                             nn :: Int
    nn   = if forall a. Integral a => a -> Bool
    odd Int
    diff then Int
    diff forall a. Num a => a -> a -> a
    + Int
    1 else Int
    diff -- keep 8-byte alignment
                         in  if   Int
    nn forall a. Ord a => a -> a -> Bool
    <= Int
    0
                             then (forall a. OrdList a
    nilOL, forall a. OrdList a
    nilOL)
                             else (forall a. a -> OrdList a
    unitOL (Int -> Instr
    moveSp (-Int
    1forall a. Num a => a -> a -> a
    *Int
    nn)), forall a. a -> OrdList a
    unitOL (Int -> Instr
    moveSp (Int
    1forall a. Num a => a -> a -> a
    *Int
    nn)))

            let transfer_code :: InstrBlock
    transfer_code
                    = forall a. [a] -> OrdList a
    toOL ([Reg] -> [Reg] -> Int -> [Instr]
    move_final [Reg]
    vregs [Reg]
    allArgRegs Int
    extraStackArgsHere)

            Platform
    platform <- NatM Platform
    getPlatform
            forall (m :: * -> *) a. Monad m => a -> m a
    return
             forall a b. (a -> b) -> a -> b
    $      InstrBlock
    argcode                 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    InstrBlock
    move_sp_down            forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    InstrBlock
    transfer_code           forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    InstrBlock
    callinsns               forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    forall a. a -> OrdList a
    unitOL Instr
    NOP              forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    InstrBlock
    move_sp_up              forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                    Platform -> [CmmFormal] -> InstrBlock
    assign_code Platform
    platform [CmmFormal]
    dest_regs

    -- | Generate code to calculate an argument, and move it into one
    --      or two integer vregs.
    arg_to_int_vregs :: CmmExpr -> NatM (OrdList Instr, [Reg])
    arg_to_int_vregs :: CmmExpr -> NatM (InstrBlock, [Reg])
    arg_to_int_vregs CmmExpr
    arg = do Platform
    platform <- NatM Platform
    getPlatform
                              Platform -> CmmExpr -> NatM (InstrBlock, [Reg])
    arg_to_int_vregs' Platform
    platform CmmExpr
    arg

    arg_to_int_vregs' :: Platform -> CmmExpr -> NatM (OrdList Instr, [Reg])
    arg_to_int_vregs' :: Platform -> CmmExpr -> NatM (InstrBlock, [Reg])
    arg_to_int_vregs' Platform
    platform CmmExpr
    arg

            -- If the expr produces a 64 bit int, then we can just use iselExpr64
            | CmmType -> Bool
    isWord64 (Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    arg)
            = do    (ChildCode64 InstrBlock
    code Reg
    r_lo) <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    arg
                    let r_hi :: Reg
    r_hi                = Reg -> Reg
    getHiVRegFromLo Reg
    r_lo
                    forall (m :: * -> *) a. Monad m => a -> m a
    return (InstrBlock
    code, [Reg
    r_hi, Reg
    r_lo])

            | Bool
    otherwise
            = do    (Reg
    src, InstrBlock
    code)     <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    arg
                    let pk :: CmmType
    pk          = Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    arg

                    case CmmType -> Format
    cmmTypeFormat CmmType
    pk of

                     -- Load a 64 bit float return value into two integer regs.
                     Format
    FF64 -> do
                            Reg
    v1 <- Format -> NatM Reg
    getNewRegNat Format
    II32
                            Reg
    v2 <- Format -> NatM Reg
    getNewRegNat Format
    II32

                            let code2 :: InstrBlock
    code2 =
                                    InstrBlock
    code                            forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                    Format -> Reg -> Reg -> Instr
    FMOV Format
    FF64 Reg
    src Reg
    f0                forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                    Format -> Reg -> AddrMode -> Instr
    ST   Format
    FF32  Reg
    f0 (Int -> AddrMode
    spRel Int
    16)        forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                    Format -> AddrMode -> Reg -> Instr
    LD   Format
    II32  (Int -> AddrMode
    spRel Int
    16) Reg
    v1        forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                    Format -> Reg -> AddrMode -> Instr
    ST   Format
    FF32  Reg
    f1 (Int -> AddrMode
    spRel Int
    16)        forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                    Format -> AddrMode -> Reg -> Instr
    LD   Format
    II32  (Int -> AddrMode
    spRel Int
    16) Reg
    v2

                            forall (m :: * -> *) a. Monad m => a -> m a
    return  (InstrBlock
    code2, [Reg
    v1,Reg
    v2])

                     -- Load a 32 bit float return value into an integer reg
                     Format
    FF32 -> do
                            Reg
    v1 <- Format -> NatM Reg
    getNewRegNat Format
    II32

                            let code2 :: InstrBlock
    code2 =
                                    InstrBlock
    code                            forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                    Format -> Reg -> AddrMode -> Instr
    ST   Format
    FF32  Reg
    src (Int -> AddrMode
    spRel Int
    16)       forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                    Format -> AddrMode -> Reg -> Instr
    LD   Format
    II32  (Int -> AddrMode
    spRel Int
    16) Reg
    v1

                            forall (m :: * -> *) a. Monad m => a -> m a
    return (InstrBlock
    code2, [Reg
    v1])

                     -- Move an integer return value into its destination reg.
                     Format
    _ -> do
                            Reg
    v1 <- Format -> NatM Reg
    getNewRegNat Format
    II32

                            let code2 :: InstrBlock
    code2 =
                                    InstrBlock
    code                            forall a. OrdList a -> a -> OrdList a
    `snocOL`
                                    Bool -> Reg -> RI -> Reg -> Instr
    OR Bool
    False Reg
    g0 (Reg -> RI
    RIReg Reg
    src) Reg
    v1

                            forall (m :: * -> *) a. Monad m => a -> m a
    return (InstrBlock
    code2, [Reg
    v1])

    -- | Move args from the integer vregs into which they have been
    --      marshalled, into %o0 .. %o5, and the rest onto the stack.
    --
    move_final :: [Reg] -> [Reg] -> Int -> [Instr]

    -- all args done
    move_final :: [Reg] -> [Reg] -> Int -> [Instr]
    move_final [] [Reg]
    _ Int
    _
            = []

    -- out of aregs; move to stack
    move_final (Reg
    v:[Reg]
    vs) [] Int
    offset
            = Format -> Reg -> AddrMode -> Instr
    ST Format
    II32 Reg
    v (Int -> AddrMode
    spRel Int
    offset)
            forall a. a -> [a] -> [a]
    : [Reg] -> [Reg] -> Int -> [Instr]
    move_final [Reg]
    vs [] (Int
    offsetforall a. Num a => a -> a -> a
    +Int
    1)

    -- move into an arg (%o[0..5]) reg
    move_final (Reg
    v:[Reg]
    vs) (Reg
    a:[Reg]
    az) Int
    offset
            = Bool -> Reg -> RI -> Reg -> Instr
    OR Bool
    False Reg
    g0 (Reg -> RI
    RIReg Reg
    v) Reg
    a
            forall a. a -> [a] -> [a]
    : [Reg] -> [Reg] -> Int -> [Instr]
    move_final [Reg]
    vs [Reg]
    az Int
    offset

    -- | Assign results returned from the call into their
    --      destination regs.
    --
    assign_code :: Platform -> [LocalReg] -> OrdList Instr

    assign_code :: Platform -> [CmmFormal] -> InstrBlock
    assign_code Platform
    _ [] = forall a. OrdList a
    nilOL

    assign_code Platform
    platform [CmmFormal
    dest]
     = let  rep :: CmmType
    rep     = CmmFormal -> CmmType
    localRegType CmmFormal
    dest
            width :: Width
    width   = CmmType -> Width
    typeWidth CmmType
    rep
            r_dest :: Reg
    r_dest  = Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform (CmmFormal -> CmmReg
    CmmLocal CmmFormal
    dest)

            result :: InstrBlock
    result
                    | CmmType -> Bool
    isFloatType CmmType
    rep
                    , Width
    W32   <- Width
    width
                    = forall a. a -> OrdList a
    unitOL forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> Reg -> Instr
    FMOV Format
    FF32 (Int -> Reg
    regSingle forall a b. (a -> b) -> a -> b
    $ Int -> Int
    fReg Int
    0) Reg
    r_dest

                    | CmmType -> Bool
    isFloatType CmmType
    rep
                    , Width
    W64   <- Width
    width
                    = forall a. a -> OrdList a
    unitOL forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> Reg -> Instr
    FMOV Format
    FF64 (Int -> Reg
    regSingle forall a b. (a -> b) -> a -> b
    $ Int -> Int
    fReg Int
    0) Reg
    r_dest

                    | Bool -> Bool
    not forall a b. (a -> b) -> a -> b
    $ CmmType -> Bool
    isFloatType CmmType
    rep
                    , Width
    W32   <- Width
    width
                    = forall a. a -> OrdList a
    unitOL forall a b. (a -> b) -> a -> b
    $ Platform -> Reg -> Reg -> Instr
    mkRegRegMoveInstr Platform
    platform (Int -> Reg
    regSingle forall a b. (a -> b) -> a -> b
    $ Int -> Int
    oReg Int
    0) Reg
    r_dest

                    | Bool -> Bool
    not forall a b. (a -> b) -> a -> b
    $ CmmType -> Bool
    isFloatType CmmType
    rep
                    , Width
    W64           <- Width
    width
                    , Reg
    r_dest_hi     <- Reg -> Reg
    getHiVRegFromLo Reg
    r_dest
                    = forall a. [a] -> OrdList a
    toOL  [ Platform -> Reg -> Reg -> Instr
    mkRegRegMoveInstr Platform
    platform (Int -> Reg
    regSingle forall a b. (a -> b) -> a -> b
    $ Int -> Int
    oReg Int
    0) Reg
    r_dest_hi
                            , Platform -> Reg -> Reg -> Instr
    mkRegRegMoveInstr Platform
    platform (Int -> Reg
    regSingle forall a b. (a -> b) -> a -> b
    $ Int -> Int
    oReg Int
    1) Reg
    r_dest]

                    | Bool
    otherwise
                    = forall a. String -> a
    panic String
    "SPARC.CodeGen.GenCCall: no match"

       in   InstrBlock
    result

    assign_code Platform
    _ [CmmFormal]
    _
            = forall a. String -> a
    panic String
    "SPARC.CodeGen.GenCCall: no match"

    -- | Generate a call to implement an out-of-line floating point operation
    outOfLineMachOp
            :: CallishMachOp
            -> NatM (Either CLabel CmmExpr)

    outOfLineMachOp :: CallishMachOp -> NatM (Either CLabel CmmExpr)
    outOfLineMachOp CallishMachOp
    mop
     = do   let functionName :: FastString
    functionName
                    = CallishMachOp -> FastString
    outOfLineMachOp_table CallishMachOp
    mop

            NCGConfig
    config  <- NatM NCGConfig
    getConfig
            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
    ForeignLabelInExternalPackage 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

    -- | Decide what C function to use to implement a CallishMachOp
    --
    outOfLineMachOp_table
            :: CallishMachOp
            -> FastString

    outOfLineMachOp_table :: CallishMachOp -> FastString
    outOfLineMachOp_table CallishMachOp
    mop
     = case CallishMachOp
    mop of
            CallishMachOp
    MO_F32_Exp    -> String -> FastString
    fsLit String
    "expf"
            CallishMachOp
    MO_F32_ExpM1  -> String -> FastString
    fsLit String
    "expm1f"
            CallishMachOp
    MO_F32_Log    -> String -> FastString
    fsLit String
    "logf"
            CallishMachOp
    MO_F32_Log1P  -> String -> FastString
    fsLit String
    "log1pf"
            CallishMachOp
    MO_F32_Sqrt   -> String -> FastString
    fsLit String
    "sqrtf"
            CallishMachOp
    MO_F32_Fabs   -> FastString
    unsupported
            CallishMachOp
    MO_F32_Pwr    -> String -> FastString
    fsLit String
    "powf"

            CallishMachOp
    MO_F32_Sin    -> String -> FastString
    fsLit String
    "sinf"
            CallishMachOp
    MO_F32_Cos    -> String -> FastString
    fsLit String
    "cosf"
            CallishMachOp
    MO_F32_Tan    -> String -> FastString
    fsLit String
    "tanf"

            CallishMachOp
    MO_F32_Asin   -> String -> FastString
    fsLit String
    "asinf"
            CallishMachOp
    MO_F32_Acos   -> String -> FastString
    fsLit String
    "acosf"
            CallishMachOp
    MO_F32_Atan   -> String -> FastString
    fsLit String
    "atanf"

            CallishMachOp
    MO_F32_Sinh   -> String -> FastString
    fsLit String
    "sinhf"
            CallishMachOp
    MO_F32_Cosh   -> String -> FastString
    fsLit String
    "coshf"
            CallishMachOp
    MO_F32_Tanh   -> String -> FastString
    fsLit String
    "tanhf"

            CallishMachOp
    MO_F32_Asinh  -> String -> FastString
    fsLit String
    "asinhf"
            CallishMachOp
    MO_F32_Acosh  -> String -> FastString
    fsLit String
    "acoshf"
            CallishMachOp
    MO_F32_Atanh  -> String -> FastString
    fsLit String
    "atanhf"

            CallishMachOp
    MO_F64_Exp    -> String -> FastString
    fsLit String
    "exp"
            CallishMachOp
    MO_F64_ExpM1  -> String -> FastString
    fsLit String
    "expm1"
            CallishMachOp
    MO_F64_Log    -> String -> FastString
    fsLit String
    "log"
            CallishMachOp
    MO_F64_Log1P  -> String -> FastString
    fsLit String
    "log1p"
            CallishMachOp
    MO_F64_Sqrt   -> String -> FastString
    fsLit String
    "sqrt"
            CallishMachOp
    MO_F64_Fabs   -> FastString
    unsupported
            CallishMachOp
    MO_F64_Pwr    -> String -> FastString
    fsLit String
    "pow"

            CallishMachOp
    MO_F64_Sin    -> String -> FastString
    fsLit String
    "sin"
            CallishMachOp
    MO_F64_Cos    -> String -> FastString
    fsLit String
    "cos"
            CallishMachOp
    MO_F64_Tan    -> String -> FastString
    fsLit String
    "tan"

            CallishMachOp
    MO_F64_Asin   -> String -> FastString
    fsLit String
    "asin"
            CallishMachOp
    MO_F64_Acos   -> String -> FastString
    fsLit String
    "acos"
            CallishMachOp
    MO_F64_Atan   -> String -> FastString
    fsLit String
    "atan"

            CallishMachOp
    MO_F64_Sinh   -> String -> FastString
    fsLit String
    "sinh"
            CallishMachOp
    MO_F64_Cosh   -> String -> FastString
    fsLit String
    "cosh"
            CallishMachOp
    MO_F64_Tanh   -> String -> FastString
    fsLit String
    "tanh"

            CallishMachOp
    MO_F64_Asinh  -> String -> FastString
    fsLit String
    "asinh"
            CallishMachOp
    MO_F64_Acosh  -> String -> FastString
    fsLit String
    "acosh"
            CallishMachOp
    MO_F64_Atanh  -> String -> FastString
    fsLit String
    "atanh"

            CallishMachOp
    MO_I64_ToI   -> String -> FastString
    fsLit String
    "hs_int64ToInt"
            CallishMachOp
    MO_I64_FromI -> String -> FastString
    fsLit String
    "hs_intToInt64"
            CallishMachOp
    MO_W64_ToW   -> String -> FastString
    fsLit String
    "hs_word64ToWord"
            CallishMachOp
    MO_W64_FromW -> String -> FastString
    fsLit String
    "hs_wordToWord64"
            CallishMachOp
    MO_x64_Neg   -> String -> FastString
    fsLit String
    "hs_neg64"
            CallishMachOp
    MO_x64_Add   -> String -> FastString
    fsLit String
    "hs_add64"
            CallishMachOp
    MO_x64_Sub   -> String -> FastString
    fsLit String
    "hs_sub64"
            CallishMachOp
    MO_x64_Mul   -> String -> FastString
    fsLit String
    "hs_mul64"
            CallishMachOp
    MO_I64_Quot  -> String -> FastString
    fsLit String
    "hs_quotInt64"
            CallishMachOp
    MO_I64_Rem   -> String -> FastString
    fsLit String
    "hs_remInt64"
            CallishMachOp
    MO_W64_Quot  -> String -> FastString
    fsLit String
    "hs_quotWord64"
            CallishMachOp
    MO_W64_Rem   -> String -> FastString
    fsLit String
    "hs_remWord64"
            CallishMachOp
    MO_x64_And   -> String -> FastString
    fsLit String
    "hs_and64"
            CallishMachOp
    MO_x64_Or    -> String -> FastString
    fsLit String
    "hs_or64"
            CallishMachOp
    MO_x64_Xor   -> String -> FastString
    fsLit String
    "hs_xor64"
            CallishMachOp
    MO_x64_Not   -> String -> FastString
    fsLit String
    "hs_not64"
            CallishMachOp
    MO_x64_Shl   -> String -> FastString
    fsLit String
    "hs_uncheckedShiftL64"
            CallishMachOp
    MO_I64_Shr   -> String -> FastString
    fsLit String
    "hs_uncheckedIShiftRA64"
            CallishMachOp
    MO_W64_Shr   -> String -> FastString
    fsLit String
    "hs_uncheckedShiftRL64"
            CallishMachOp
    MO_x64_Eq    -> String -> FastString
    fsLit String
    "hs_eq64"
            CallishMachOp
    MO_x64_Ne    -> String -> FastString
    fsLit String
    "hs_ne64"
            CallishMachOp
    MO_I64_Ge    -> String -> FastString
    fsLit String
    "hs_geInt64"
            CallishMachOp
    MO_I64_Gt    -> String -> FastString
    fsLit String
    "hs_gtInt64"
            CallishMachOp
    MO_I64_Le    -> String -> FastString
    fsLit String
    "hs_leInt64"
            CallishMachOp
    MO_I64_Lt    -> String -> FastString
    fsLit String
    "hs_ltInt64"
            CallishMachOp
    MO_W64_Ge    -> String -> FastString
    fsLit String
    "hs_geWord64"
            CallishMachOp
    MO_W64_Gt    -> String -> FastString
    fsLit String
    "hs_gtWord64"
            CallishMachOp
    MO_W64_Le    -> String -> FastString
    fsLit String
    "hs_leWord64"
            CallishMachOp
    MO_W64_Lt    -> String -> FastString
    fsLit String
    "hs_ltWord64"

            MO_UF_Conv Width
    w -> String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    word2FloatLabel Width
    w

            MO_Memcpy Int
    _  -> String -> FastString
    fsLit String
    "memcpy"
            MO_Memset Int
    _  -> String -> FastString
    fsLit String
    "memset"
            MO_Memmove Int
    _ -> String -> FastString
    fsLit String
    "memmove"
            MO_Memcmp Int
    _  -> String -> FastString
    fsLit String
    "memcmp"

            MO_BSwap Width
    w   -> String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    bSwapLabel Width
    w
            MO_BRev Width
    w    -> String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    bRevLabel Width
    w
            MO_PopCnt Width
    w  -> String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    popCntLabel Width
    w
            MO_Pdep Width
    w    -> String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    pdepLabel Width
    w
            MO_Pext Width
    w    -> String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    pextLabel Width
    w
            MO_Clz Width
    w     -> String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    clzLabel Width
    w
            MO_Ctz Width
    w     -> String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    ctzLabel Width
    w
            MO_AtomicRMW Width
    w AtomicMachOp
    amop -> String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> AtomicMachOp -> String
    atomicRMWLabel Width
    w AtomicMachOp
    amop
            MO_Cmpxchg Width
    w -> String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    cmpxchgLabel Width
    w
            MO_Xchg Width
    w -> String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    xchgLabel Width
    w
            MO_AtomicRead Width
    w -> String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    atomicReadLabel Width
    w
            MO_AtomicWrite Width
    w -> String -> FastString
    fsLit forall a b. (a -> b) -> a -> b
    $ Width -> String
    atomicWriteLabel Width
    w

            MO_S_Mul2    {}  -> FastString
    unsupported
            MO_S_QuotRem {}  -> FastString
    unsupported
            MO_U_QuotRem {}  -> FastString
    unsupported
            MO_U_QuotRem2 {} -> FastString
    unsupported
            MO_Add2 {}       -> FastString
    unsupported
            MO_AddWordC {}   -> FastString
    unsupported
            MO_SubWordC {}   -> FastString
    unsupported
            MO_AddIntC {}    -> FastString
    unsupported
            MO_SubIntC {}    -> FastString
    unsupported
            MO_U_Mul2 {}     -> FastString
    unsupported
            CallishMachOp
    MO_ReadBarrier   -> FastString
    unsupported
            CallishMachOp
    MO_WriteBarrier  -> FastString
    unsupported
            CallishMachOp
    MO_Touch         -> FastString
    unsupported
            (MO_Prefetch_Data Int
    _) -> FastString
    unsupported
        where unsupported :: FastString
    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 here")