    -- | Evaluation of 32 bit values.
    module GHC.CmmToAsm.SPARC.CodeGen.Gen32 (
            getSomeReg,
            getRegister
    )

    where

    import GHC.Prelude

    import GHC.CmmToAsm.SPARC.CodeGen.CondCode
    import GHC.CmmToAsm.SPARC.CodeGen.Amode
    import GHC.CmmToAsm.SPARC.CodeGen.Gen64
    import GHC.CmmToAsm.SPARC.CodeGen.Base
    import GHC.CmmToAsm.SPARC.Stack
    import GHC.CmmToAsm.SPARC.Instr
    import GHC.CmmToAsm.SPARC.Cond
    import GHC.CmmToAsm.SPARC.AddrMode
    import GHC.CmmToAsm.SPARC.Imm
    import GHC.CmmToAsm.SPARC.Regs
    import GHC.CmmToAsm.SPARC.Base
    import GHC.CmmToAsm.Monad
    import GHC.CmmToAsm.Format
    import GHC.Platform.Reg

    import GHC.Cmm

    import Control.Monad (liftM)
    import GHC.Data.OrdList
    import GHC.Utils.Outputable

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

    -- | Make code to evaluate a 32 bit expression.
    --
    getRegister :: CmmExpr -> NatM Register

    getRegister :: CmmExpr -> NatM Register
    getRegister (CmmReg CmmReg
    reg)
      = do Platform
    platform <- NatM Platform
    getPlatform
           Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> Reg -> InstrBlock -> Register
    Fixed (CmmType -> Format
    cmmTypeFormat (Platform -> CmmReg -> CmmType
    cmmRegType Platform
    platform CmmReg
    reg))
                         (Platform -> CmmReg -> Reg
    getRegisterReg Platform
    platform CmmReg
    reg) InstrBlock
    forall a. OrdList a
    nilOL)

    getRegister tree :: CmmExpr
    tree@(CmmRegOff CmmReg
    _ Int
    _)
      = do Platform
    platform <- NatM Platform
    getPlatform
           CmmExpr -> NatM Register
    getRegister (Platform -> CmmExpr -> CmmExpr
    mangleIndexTree Platform
    platform CmmExpr
    tree)

    getRegister (CmmMachOp (MO_UU_Conv Width
    W64 Width
    W32)
                 [CmmMachOp (MO_U_Shr Width
    W64) [CmmExpr
    x,CmmLit (CmmInt Integer
    32 Width
    _)]]) = do
      ChildCode64 InstrBlock
    code Reg
    rlo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    x
      Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> InstrBlock -> Register
    Fixed Format
    II32 (Reg -> Reg
    getHiVRegFromLo Reg
    rlo) InstrBlock
    code

    getRegister (CmmMachOp (MO_SS_Conv Width
    W64 Width
    W32)
                 [CmmMachOp (MO_U_Shr Width
    W64) [CmmExpr
    x,CmmLit (CmmInt Integer
    32 Width
    _)]]) = do
      ChildCode64 InstrBlock
    code Reg
    rlo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    x
      Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> InstrBlock -> Register
    Fixed Format
    II32 (Reg -> Reg
    getHiVRegFromLo Reg
    rlo) InstrBlock
    code

    getRegister (CmmMachOp (MO_UU_Conv Width
    W64 Width
    W32) [CmmExpr
    x]) = do
      ChildCode64 InstrBlock
    code Reg
    rlo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    x
      Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> InstrBlock -> Register
    Fixed Format
    II32 Reg
    rlo InstrBlock
    code

    getRegister (CmmMachOp (MO_SS_Conv Width
    W64 Width
    W32) [CmmExpr
    x]) = do
      ChildCode64 InstrBlock
    code Reg
    rlo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    x
      Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> Reg -> InstrBlock -> Register
    Fixed Format
    II32 Reg
    rlo InstrBlock
    code

    -- Load a literal float into a float register.
    --      The actual literal is stored in a new data area, and we load it
    --      at runtime.
    getRegister (CmmLit (CmmFloat Rational
    f Width
    W32)) = do

        -- a label for the new data area
        CLabel
    lbl <- NatM CLabel
    getNewLabelNat
        Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    II32

        let code :: Reg -> InstrBlock
    code Reg
    dst = [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL [
                -- the data area
                Section -> RawCmmStatics -> Instr
    LDATA (SectionType -> CLabel -> Section
    Section SectionType
    ReadOnlyData CLabel
    lbl) (RawCmmStatics -> Instr) -> RawCmmStatics -> Instr
    forall a b. (a -> b) -> a -> b
    $ CLabel -> [CmmStatic] -> RawCmmStatics
    forall (rawOnly :: Bool).
    CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
    CmmStaticsRaw CLabel
    lbl
                             [CmmLit -> CmmStatic
    CmmStaticLit (Rational -> Width -> CmmLit
    CmmFloat Rational
    f Width
    W32)],

                -- load the literal
                Imm -> Reg -> Instr
    SETHI (Imm -> Imm
    HI (CLabel -> Imm
    ImmCLbl CLabel
    lbl)) Reg
    tmp,
                Format -> AddrMode -> Reg -> Instr
    LD Format
    II32 (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    tmp (Imm -> Imm
    LO (CLabel -> Imm
    ImmCLbl CLabel
    lbl))) Reg
    dst]

        Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    FF32 Reg -> InstrBlock
    code)

    getRegister (CmmLit (CmmFloat Rational
    d Width
    W64)) = do
        CLabel
    lbl <- NatM CLabel
    getNewLabelNat
        Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    II32
        let code :: Reg -> InstrBlock
    code Reg
    dst = [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL [
                Section -> RawCmmStatics -> Instr
    LDATA (SectionType -> CLabel -> Section
    Section SectionType
    ReadOnlyData CLabel
    lbl) (RawCmmStatics -> Instr) -> RawCmmStatics -> Instr
    forall a b. (a -> b) -> a -> b
    $ CLabel -> [CmmStatic] -> RawCmmStatics
    forall (rawOnly :: Bool).
    CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
    CmmStaticsRaw CLabel
    lbl
                             [CmmLit -> CmmStatic
    CmmStaticLit (Rational -> Width -> CmmLit
    CmmFloat Rational
    d Width
    W64)],
                Imm -> Reg -> Instr
    SETHI (Imm -> Imm
    HI (CLabel -> Imm
    ImmCLbl CLabel
    lbl)) Reg
    tmp,
                Format -> AddrMode -> Reg -> Instr
    LD Format
    II64 (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    tmp (Imm -> Imm
    LO (CLabel -> Imm
    ImmCLbl CLabel
    lbl))) Reg
    dst]
        Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    FF64 Reg -> InstrBlock
    code)

    -- Unary machine ops
    getRegister (CmmMachOp MachOp
    mop [CmmExpr
    x])
      = case MachOp
    mop of
            -- Floating point negation -------------------------
            MO_F_Neg Width
    W32            -> Format -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register
    trivialUFCode Format
    FF32 (Format -> Reg -> Reg -> Instr
    FNEG Format
    FF32) CmmExpr
    x
            MO_F_Neg Width
    W64            -> Format -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register
    trivialUFCode Format
    FF64 (Format -> Reg -> Reg -> Instr
    FNEG Format
    FF64) CmmExpr
    x

            -- Integer negation --------------------------------
            MO_S_Neg Width
    rep            -> Format -> (RI -> Reg -> Instr) -> CmmExpr -> NatM Register
    trivialUCode (Width -> Format
    intFormat Width
    rep) (Bool -> Bool -> Reg -> RI -> Reg -> Instr
    SUB Bool
    False Bool
    False Reg
    g0) CmmExpr
    x
            MO_Not Width
    rep              -> Format -> (RI -> Reg -> Instr) -> CmmExpr -> NatM Register
    trivialUCode (Width -> Format
    intFormat Width
    rep) (Bool -> Reg -> RI -> Reg -> Instr
    XNOR Bool
    False Reg
    g0) CmmExpr
    x

            -- Float word size conversion ----------------------
            MO_FF_Conv Width
    W64 Width
    W32      -> CmmExpr -> NatM Register
    coerceDbl2Flt CmmExpr
    x
            MO_FF_Conv Width
    W32 Width
    W64      -> CmmExpr -> NatM Register
    coerceFlt2Dbl CmmExpr
    x

            -- Float <-> Signed Int conversion -----------------
            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

            -- Unsigned integer word size conversions ----------

            -- If it's the same size, then nothing needs to be done.
            MO_UU_Conv Width
    from Width
    to
             | Width
    from Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    to           -> Format -> CmmExpr -> NatM Register
    conversionNop (Width -> Format
    intFormat Width
    to)  CmmExpr
    x

            -- To narrow an unsigned word, mask out the high bits to simulate what would
            --      happen if we copied the value into a smaller register.
            MO_UU_Conv Width
    W16 Width
    W8       -> Width
    -> (Reg -> RI -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    W8  (Bool -> Reg -> RI -> Reg -> Instr
    AND Bool
    False) CmmExpr
    x (CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt Integer
    255 Width
    W8))
            MO_UU_Conv Width
    W32 Width
    W8       -> Width
    -> (Reg -> RI -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    W8  (Bool -> Reg -> RI -> Reg -> Instr
    AND Bool
    False) CmmExpr
    x (CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt Integer
    255 Width
    W8))

            -- for narrowing 32 bit to 16 bit, don't use a literal mask value like the W16->W8
            --      case because the only way we can load it is via SETHI, which needs 2 ops.
            --      Do some shifts to chop out the high bits instead.
            MO_UU_Conv Width
    W32 Width
    W16
             -> do  Reg
    tmpReg          <- Format -> NatM Reg
    getNewRegNat Format
    II32
                    (Reg
    xReg, InstrBlock
    xCode)   <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
                    let code :: Reg -> InstrBlock
    code Reg
    dst
                            =       InstrBlock
    xCode
                            InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL
                                    [ Reg -> RI -> Reg -> Instr
    SLL Reg
    xReg   (Imm -> RI
    RIImm (Imm -> RI) -> Imm -> RI
    forall a b. (a -> b) -> a -> b
    $ Int -> Imm
    ImmInt Int
    16) Reg
    tmpReg
                                    , Reg -> RI -> Reg -> Instr
    SRL Reg
    tmpReg (Imm -> RI
    RIImm (Imm -> RI) -> Imm -> RI
    forall a b. (a -> b) -> a -> b
    $ Int -> Imm
    ImmInt Int
    16) Reg
    dst]

                    Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return  (Register -> NatM Register) -> Register -> NatM Register
    forall a b. (a -> b) -> a -> b
    $ Format -> (Reg -> InstrBlock) -> Register
    Any Format
    II32 Reg -> InstrBlock
    code

                    --       trivialCode W16 (AND False) x (CmmLit (CmmInt 65535 W16))

            -- To widen an unsigned word we don't have to do anything.
            --      Just leave it in the same register and mark the result as the new size.
            MO_UU_Conv Width
    W8  Width
    W16      -> Format -> CmmExpr -> NatM Register
    conversionNop (Width -> Format
    intFormat Width
    W16)  CmmExpr
    x
            MO_UU_Conv Width
    W8  Width
    W32      -> Format -> CmmExpr -> NatM Register
    conversionNop (Width -> Format
    intFormat Width
    W32)  CmmExpr
    x
            MO_UU_Conv Width
    W16 Width
    W32      -> Format -> CmmExpr -> NatM Register
    conversionNop (Width -> Format
    intFormat Width
    W32)  CmmExpr
    x

            -- Signed integer word size conversions ------------

            -- Mask out high bits when narrowing them
            MO_SS_Conv Width
    W16 Width
    W8       -> Width
    -> (Reg -> RI -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    W8  (Bool -> Reg -> RI -> Reg -> Instr
    AND Bool
    False) CmmExpr
    x (CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt Integer
    255 Width
    W8))
            MO_SS_Conv Width
    W32 Width
    W8       -> Width
    -> (Reg -> RI -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    W8  (Bool -> Reg -> RI -> Reg -> Instr
    AND Bool
    False) CmmExpr
    x (CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt Integer
    255 Width
    W8))
            MO_SS_Conv Width
    W32 Width
    W16      -> Width
    -> (Reg -> RI -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    W16 (Bool -> Reg -> RI -> Reg -> Instr
    AND Bool
    False) CmmExpr
    x (CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt Integer
    65535 Width
    W16))

            -- Sign extend signed words when widening them.
            MO_SS_Conv Width
    W8  Width
    W16      -> Width -> Width -> CmmExpr -> NatM Register
    integerExtend Width
    W8  Width
    W16 CmmExpr
    x
            MO_SS_Conv Width
    W8  Width
    W32      -> Width -> Width -> CmmExpr -> NatM Register
    integerExtend Width
    W8  Width
    W32 CmmExpr
    x
            MO_SS_Conv Width
    W16 Width
    W32      -> Width -> Width -> CmmExpr -> NatM Register
    integerExtend Width
    W16 Width
    W32 CmmExpr
    x

            MachOp
    _                       -> String -> NatM Register
    forall a. String -> a
    panic (String
    "Unknown unary mach op: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ MachOp -> String
    forall a. Show a => a -> String
    show MachOp
    mop)

    -- Binary machine ops
    getRegister (CmmMachOp MachOp
    mop [CmmExpr
    x, CmmExpr
    y])
      = case MachOp
    mop of
          MO_Eq Width
    _           -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condIntReg Cond
    EQQ CmmExpr
    x CmmExpr
    y
          MO_Ne Width
    _           -> Cond -> CmmExpr -> CmmExpr -> NatM Register
    condIntReg Cond
    NE CmmExpr
    x CmmExpr
    y

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

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

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

          MO_Add Width
    W32        -> Width
    -> (Reg -> RI -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    W32 (Bool -> Bool -> Reg -> RI -> Reg -> Instr
    ADD Bool
    False Bool
    False) CmmExpr
    x CmmExpr
    y
          MO_Sub Width
    W32        -> Width
    -> (Reg -> RI -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    W32 (Bool -> Bool -> Reg -> RI -> Reg -> Instr
    SUB Bool
    False Bool
    False) CmmExpr
    x CmmExpr
    y

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

          MO_S_Quot Width
    W32     -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    idiv Bool
    True  Bool
    False CmmExpr
    x CmmExpr
    y
          MO_U_Quot Width
    W32     -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    idiv Bool
    False Bool
    False CmmExpr
    x CmmExpr
    y

          MO_S_Rem  Width
    W32     -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    irem Bool
    True  CmmExpr
    x CmmExpr
    y
          MO_U_Rem  Width
    W32     -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    irem Bool
    False CmmExpr
    x CmmExpr
    y

          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_F_Add  Width
    w       -> Width
    -> (Format -> Reg -> Reg -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialFCode Width
    w Format -> Reg -> Reg -> Reg -> Instr
    FADD CmmExpr
    x CmmExpr
    y
          MO_F_Sub  Width
    w       -> Width
    -> (Format -> Reg -> Reg -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialFCode Width
    w Format -> Reg -> Reg -> Reg -> Instr
    FSUB CmmExpr
    x CmmExpr
    y
          MO_F_Mul  Width
    w       -> Width
    -> (Format -> Reg -> Reg -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialFCode Width
    w Format -> Reg -> Reg -> Reg -> Instr
    FMUL CmmExpr
    x CmmExpr
    y
          MO_F_Quot Width
    w       -> Width
    -> (Format -> Reg -> Reg -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialFCode Width
    w Format -> Reg -> Reg -> Reg -> Instr
    FDIV CmmExpr
    x CmmExpr
    y

          MO_And Width
    rep        -> Width
    -> (Reg -> RI -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    rep (Bool -> Reg -> RI -> Reg -> Instr
    AND Bool
    False) CmmExpr
    x CmmExpr
    y
          MO_Or  Width
    rep        -> Width
    -> (Reg -> RI -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    rep (Bool -> Reg -> RI -> Reg -> Instr
    OR  Bool
    False) CmmExpr
    x CmmExpr
    y
          MO_Xor Width
    rep        -> Width
    -> (Reg -> RI -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    rep (Bool -> Reg -> RI -> Reg -> Instr
    XOR Bool
    False) CmmExpr
    x CmmExpr
    y

          MO_Mul Width
    rep        -> Width
    -> (Reg -> RI -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    rep (Bool -> Reg -> RI -> Reg -> Instr
    SMUL Bool
    False) CmmExpr
    x CmmExpr
    y

          MO_Shl Width
    rep        -> Width
    -> (Reg -> RI -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    rep Reg -> RI -> Reg -> Instr
    SLL  CmmExpr
    x CmmExpr
    y
          MO_U_Shr Width
    rep      -> Width
    -> (Reg -> RI -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    rep Reg -> RI -> Reg -> Instr
    SRL CmmExpr
    x CmmExpr
    y
          MO_S_Shr Width
    rep      -> Width
    -> (Reg -> RI -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    rep Reg -> RI -> Reg -> Instr
    SRA CmmExpr
    x CmmExpr
    y

          MachOp
    _                 -> String -> SDoc -> NatM Register
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getRegister(sparc) - binary CmmMachOp (1)" (MachOp -> SDoc
    pprMachOp MachOp
    mop)

    getRegister (CmmLoad CmmExpr
    mem CmmType
    pk) = do
        Amode AddrMode
    src InstrBlock
    code <- CmmExpr -> NatM Amode
    getAmode CmmExpr
    mem
        let
            code__2 :: Reg -> InstrBlock
    code__2 Reg
    dst     = InstrBlock
    code InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> AddrMode -> Reg -> Instr
    LD (CmmType -> Format
    cmmTypeFormat CmmType
    pk) AddrMode
    src Reg
    dst
        Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any (CmmType -> Format
    cmmTypeFormat CmmType
    pk) Reg -> InstrBlock
    code__2)

    getRegister (CmmLit (CmmInt Integer
    i Width
    _))
      | Integer -> Bool
    forall a. Integral a => a -> Bool
    fits13Bits Integer
    i
      = let
            src :: Imm
    src = Int -> Imm
    ImmInt (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    i)
            code :: Reg -> InstrBlock
    code Reg
    dst = Instr -> InstrBlock
    forall a. a -> OrdList a
    unitOL (Bool -> Reg -> RI -> Reg -> Instr
    OR Bool
    False Reg
    g0 (Imm -> RI
    RIImm Imm
    src) Reg
    dst)
        in
            Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    II32 Reg -> InstrBlock
    code)

    getRegister (CmmLit CmmLit
    lit)
      = let imm :: Imm
    imm = CmmLit -> Imm
    litToImm CmmLit
    lit
            code :: Reg -> InstrBlock
    code Reg
    dst = [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL [
                Imm -> Reg -> Instr
    SETHI (Imm -> Imm
    HI Imm
    imm) Reg
    dst,
                Bool -> Reg -> RI -> Reg -> Instr
    OR Bool
    False Reg
    dst (Imm -> RI
    RIImm (Imm -> Imm
    LO Imm
    imm)) Reg
    dst]
        in Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    II32 Reg -> InstrBlock
    code)

    getRegister CmmExpr
    _
            = String -> NatM Register
    forall a. String -> a
    panic String
    "SPARC.CodeGen.Gen32.getRegister: no match"

    -- | sign extend and widen
    integerExtend
            :: Width                -- ^ width of source expression
            -> Width                -- ^ width of result
            -> CmmExpr              -- ^ source expression
            -> NatM Register

    integerExtend :: Width -> Width -> CmmExpr -> NatM Register
    integerExtend Width
    from Width
    to CmmExpr
    expr
     = do   -- load the expr into some register
            (Reg
    reg, InstrBlock
    e_code)   <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    expr
            Reg
    tmp             <- Format -> NatM Reg
    getNewRegNat Format
    II32
            let bitCount :: Int
    bitCount
                    = case (Width
    from, Width
    to) of
                            (Width
    W8,  Width
    W32)      -> Int
    24
                            (Width
    W16, Width
    W32)      -> Int
    16
                            (Width
    W8,  Width
    W16)      -> Int
    24
                            (Width, Width)
    _               -> String -> Int
    forall a. String -> a
    panic String
    "SPARC.CodeGen.Gen32: no match"
            let code :: Reg -> InstrBlock
    code Reg
    dst
                    = InstrBlock
    e_code

                    -- local shift word left to load the sign bit
                    InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL`  Reg -> RI -> Reg -> Instr
    SLL Reg
    reg (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    bitCount)) Reg
    tmp

                    -- arithmetic shift right to sign extend
                    InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL`  Reg -> RI -> Reg -> Instr
    SRA Reg
    tmp (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    bitCount)) Reg
    dst

            Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any (Width -> Format
    intFormat Width
    to) Reg -> InstrBlock
    code)

    -- | For nop word format conversions we set the resulting value to have the
    --      required size, but don't need to generate any actual code.
    --
    conversionNop
            :: Format -> CmmExpr -> NatM Register

    conversionNop :: Format -> CmmExpr -> NatM Register
    conversionNop Format
    new_rep CmmExpr
    expr
     = do   Register
    e_code <- CmmExpr -> NatM Register
    getRegister CmmExpr
    expr
            Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Register -> Format -> Register
    setFormatOfRegister Register
    e_code Format
    new_rep)

    -- | Generate an integer division instruction.
    idiv :: Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register

    -- For unsigned division with a 32 bit numerator,
    --              we can just clear the Y register.
    idiv :: Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    idiv Bool
    False Bool
    cc CmmExpr
    x CmmExpr
    y
     = do
            (Reg
    a_reg, InstrBlock
    a_code)         <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
            (Reg
    b_reg, InstrBlock
    b_code)         <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    y

            let code :: Reg -> InstrBlock
    code Reg
    dst
                    =       InstrBlock
    a_code
                    InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` InstrBlock
    b_code
                    InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL
                            [ Reg -> Reg -> Instr
    WRY  Reg
    g0 Reg
    g0
                            , Bool -> Reg -> RI -> Reg -> Instr
    UDIV Bool
    cc Reg
    a_reg (Reg -> RI
    RIReg Reg
    b_reg) Reg
    dst]

            Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    II32 Reg -> InstrBlock
    code)

    -- For _signed_ division with a 32 bit numerator,
    --              we have to sign extend the numerator into the Y register.
    idiv Bool
    True Bool
    cc CmmExpr
    x CmmExpr
    y
     = do
            (Reg
    a_reg, InstrBlock
    a_code)         <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
            (Reg
    b_reg, InstrBlock
    b_code)         <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    y

            Reg
    tmp                     <- Format -> NatM Reg
    getNewRegNat Format
    II32

            let code :: Reg -> InstrBlock
    code Reg
    dst
                    =       InstrBlock
    a_code
                    InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` InstrBlock
    b_code
                    InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL
                            [ Reg -> RI -> Reg -> Instr
    SRA  Reg
    a_reg (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    16)) Reg
    tmp            -- sign extend
                            , Reg -> RI -> Reg -> Instr
    SRA  Reg
    tmp   (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    16)) Reg
    tmp

                            , Reg -> Reg -> Instr
    WRY  Reg
    tmp Reg
    g0
                            , Bool -> Reg -> RI -> Reg -> Instr
    SDIV Bool
    cc Reg
    a_reg (Reg -> RI
    RIReg Reg
    b_reg) Reg
    dst]

            Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    II32 Reg -> InstrBlock
    code)

    -- | Do an integer remainder.
    --
    --       NOTE:  The SPARC v8 architecture manual says that integer division
    --              instructions _may_ generate a remainder, depending on the implementation.
    --              If so it is _recommended_ that the remainder is placed in the Y register.
    --
    --          The UltraSparc 2007 manual says Y is _undefined_ after division.
    --
    --              The SPARC T2 doesn't store the remainder, not sure about the others.
    --              It's probably best not to worry about it, and just generate our own
    --              remainders.
    --
    irem :: Bool -> CmmExpr -> CmmExpr -> NatM Register

    -- For unsigned operands:
    --              Division is between a 64 bit numerator and a 32 bit denominator,
    --              so we still have to clear the Y register.
    irem :: Bool -> CmmExpr -> CmmExpr -> NatM Register
    irem Bool
    False CmmExpr
    x CmmExpr
    y
     = do
            (Reg
    a_reg, InstrBlock
    a_code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
            (Reg
    b_reg, InstrBlock
    b_code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    y

            Reg
    tmp_reg         <- Format -> NatM Reg
    getNewRegNat Format
    II32

            let code :: Reg -> InstrBlock
    code Reg
    dst
                    =       InstrBlock
    a_code
                    InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` InstrBlock
    b_code
                    InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL
                            [ Reg -> Reg -> Instr
    WRY   Reg
    g0 Reg
    g0
                            , Bool -> Reg -> RI -> Reg -> Instr
    UDIV  Bool
    False         Reg
    a_reg (Reg -> RI
    RIReg Reg
    b_reg) Reg
    tmp_reg
                            , Bool -> Reg -> RI -> Reg -> Instr
    UMUL  Bool
    False       Reg
    tmp_reg (Reg -> RI
    RIReg Reg
    b_reg) Reg
    tmp_reg
                            , Bool -> Bool -> Reg -> RI -> Reg -> Instr
    SUB   Bool
    False Bool
    False   Reg
    a_reg (Reg -> RI
    RIReg Reg
    tmp_reg) Reg
    dst]

            Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return  (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    II32 Reg -> InstrBlock
    code)

    -- For signed operands:
    --              Make sure to sign extend into the Y register, or the remainder
    --              will have the wrong sign when the numerator is negative.
    --
    --      TODO:   When sign extending, GCC only shifts the a_reg right by 17 bits,
    --              not the full 32. Not sure why this is, something to do with overflow?
    --              If anyone cares enough about the speed of signed remainder they
    --              can work it out themselves (then tell me). -- BL 2009/01/20
    irem Bool
    True CmmExpr
    x CmmExpr
    y
     = do
            (Reg
    a_reg, InstrBlock
    a_code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
            (Reg
    b_reg, InstrBlock
    b_code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    y

            Reg
    tmp1_reg        <- Format -> NatM Reg
    getNewRegNat Format
    II32
            Reg
    tmp2_reg        <- Format -> NatM Reg
    getNewRegNat Format
    II32

            let code :: Reg -> InstrBlock
    code Reg
    dst
                    =       InstrBlock
    a_code
                    InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` InstrBlock
    b_code
                    InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL
                            [ Reg -> RI -> Reg -> Instr
    SRA   Reg
    a_reg      (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    16)) Reg
    tmp1_reg -- sign extend
                            , Reg -> RI -> Reg -> Instr
    SRA   Reg
    tmp1_reg   (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    16)) Reg
    tmp1_reg -- sign extend
                            , Reg -> Reg -> Instr
    WRY   Reg
    tmp1_reg Reg
    g0

                            , Bool -> Reg -> RI -> Reg -> Instr
    SDIV  Bool
    False          Reg
    a_reg (Reg -> RI
    RIReg Reg
    b_reg)    Reg
    tmp2_reg
                            , Bool -> Reg -> RI -> Reg -> Instr
    SMUL  Bool
    False       Reg
    tmp2_reg (Reg -> RI
    RIReg Reg
    b_reg)    Reg
    tmp2_reg
                            , Bool -> Bool -> Reg -> RI -> Reg -> Instr
    SUB   Bool
    False Bool
    False    Reg
    a_reg (Reg -> RI
    RIReg Reg
    tmp2_reg) Reg
    dst]

            Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    II32 Reg -> InstrBlock
    code)

    imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
    imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
    imulMayOflo Width
    rep CmmExpr
    a CmmExpr
    b
     = do
            (Reg
    a_reg, InstrBlock
    a_code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    a
            (Reg
    b_reg, InstrBlock
    b_code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    b
            Reg
    res_lo <- Format -> NatM Reg
    getNewRegNat Format
    II32
            Reg
    res_hi <- Format -> NatM Reg
    getNewRegNat Format
    II32

            let shift_amt :: Int
    shift_amt  = case Width
    rep of
                              Width
    W32 -> Int
    31
                              Width
    W64 -> Int
    63
                              Width
    _ -> String -> Int
    forall a. String -> a
    panic String
    "shift_amt"

            let code :: Reg -> InstrBlock
    code Reg
    dst = InstrBlock
    a_code InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` InstrBlock
    b_code InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`
                           [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL [
                               Bool -> Reg -> RI -> Reg -> Instr
    SMUL Bool
    False Reg
    a_reg (Reg -> RI
    RIReg Reg
    b_reg) Reg
    res_lo,
                               Reg -> Instr
    RDY Reg
    res_hi,
                               Reg -> RI -> Reg -> Instr
    SRA Reg
    res_lo (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    shift_amt)) Reg
    res_lo,
                               Bool -> Bool -> Reg -> RI -> Reg -> Instr
    SUB Bool
    False Bool
    False Reg
    res_lo (Reg -> RI
    RIReg Reg
    res_hi) Reg
    dst
                            ]
            Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    II32 Reg -> InstrBlock
    code)

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

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

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

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

    trivialCode :: Width
    -> (Reg -> RI -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialCode Width
    _ Reg -> RI -> Reg -> Instr
    instr CmmExpr
    x (CmmLit (CmmInt Integer
    y Width
    _))
      | Integer -> Bool
    forall a. Integral a => a -> Bool
    fits13Bits Integer
    y
      = do
          (Reg
    src1, InstrBlock
    code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
          let
            src2 :: Imm
    src2 = Int -> Imm
    ImmInt (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    y)
            code__2 :: Reg -> InstrBlock
    code__2 Reg
    dst = InstrBlock
    code InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> RI -> Reg -> Instr
    instr Reg
    src1 (Imm -> RI
    RIImm Imm
    src2) Reg
    dst
          Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    II32 Reg -> InstrBlock
    code__2)

    trivialCode Width
    _ Reg -> RI -> Reg -> Instr
    instr CmmExpr
    x CmmExpr
    y = do
        (Reg
    src1, InstrBlock
    code1) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
        (Reg
    src2, InstrBlock
    code2) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    y
        let
            code__2 :: Reg -> InstrBlock
    code__2 Reg
    dst = InstrBlock
    code1 InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` InstrBlock
    code2 InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                          Reg -> RI -> Reg -> Instr
    instr Reg
    src1 (Reg -> RI
    RIReg Reg
    src2) Reg
    dst
        Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    II32 Reg -> InstrBlock
    code__2)

    trivialFCode
            :: Width
            -> (Format -> Reg -> Reg -> Reg -> Instr)
            -> CmmExpr
            -> CmmExpr
            -> NatM Register

    trivialFCode :: Width
    -> (Format -> Reg -> Reg -> Reg -> Instr)
    -> CmmExpr
    -> CmmExpr
    -> NatM Register
    trivialFCode Width
    pk Format -> Reg -> Reg -> Reg -> Instr
    instr CmmExpr
    x CmmExpr
    y = do
        Platform
    platform <- NatM Platform
    getPlatform
        (Reg
    src1, InstrBlock
    code1) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
        (Reg
    src2, InstrBlock
    code2) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    y
        Reg
    tmp <- Format -> NatM Reg
    getNewRegNat Format
    FF64
        let
            promote :: Reg -> Instr
    promote Reg
    x = Format -> Format -> Reg -> Reg -> Instr
    FxTOy Format
    FF32 Format
    FF64 Reg
    x Reg
    tmp

            pk1 :: CmmType
    pk1   = Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    x
            pk2 :: CmmType
    pk2   = Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    y

            code__2 :: Reg -> InstrBlock
    code__2 Reg
    dst =
                    if CmmType
    pk1 CmmType -> CmmType -> Bool
    `cmmEqType` CmmType
    pk2 then
                        InstrBlock
    code1 InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` InstrBlock
    code2 InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                        Format -> Reg -> Reg -> Reg -> Instr
    instr (Width -> Format
    floatFormat Width
    pk) Reg
    src1 Reg
    src2 Reg
    dst
                    else if CmmType -> Width
    typeWidth CmmType
    pk1 Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    W32 then
                        InstrBlock
    code1 InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Instr
    promote Reg
    src1 InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` InstrBlock
    code2 InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                        Format -> Reg -> Reg -> Reg -> Instr
    instr Format
    FF64 Reg
    tmp Reg
    src2 Reg
    dst
                    else
                        InstrBlock
    code1 InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` InstrBlock
    code2 InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Instr
    promote Reg
    src2 InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL`
                        Format -> Reg -> Reg -> Reg -> Instr
    instr Format
    FF64 Reg
    src1 Reg
    tmp Reg
    dst
        Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any (CmmType -> Format
    cmmTypeFormat (CmmType -> Format) -> CmmType -> Format
    forall a b. (a -> b) -> a -> b
    $ if CmmType
    pk1 CmmType -> CmmType -> Bool
    `cmmEqType` CmmType
    pk2 then CmmType
    pk1 else Width -> CmmType
    cmmFloat Width
    W64)
                    Reg -> InstrBlock
    code__2)

    trivialUCode
            :: Format
            -> (RI -> Reg -> Instr)
            -> CmmExpr
            -> NatM Register

    trivialUCode :: Format -> (RI -> Reg -> Instr) -> CmmExpr -> NatM Register
    trivialUCode Format
    format RI -> Reg -> Instr
    instr CmmExpr
    x = do
        (Reg
    src, InstrBlock
    code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
        let
            code__2 :: Reg -> InstrBlock
    code__2 Reg
    dst = InstrBlock
    code InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL` RI -> Reg -> Instr
    instr (Reg -> RI
    RIReg Reg
    src) Reg
    dst
        Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    format Reg -> InstrBlock
    code__2)

    trivialUFCode
            :: Format
            -> (Reg -> Reg -> Instr)
            -> CmmExpr
            -> NatM Register

    trivialUFCode :: Format -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register
    trivialUFCode Format
    pk Reg -> Reg -> Instr
    instr CmmExpr
    x = do
        (Reg
    src, InstrBlock
    code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
        let
            code__2 :: Reg -> InstrBlock
    code__2 Reg
    dst = InstrBlock
    code InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Reg -> Reg -> Instr
    instr Reg
    src Reg
    dst
        Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    pk Reg -> InstrBlock
    code__2)

    -- Coercions -------------------------------------------------------------------

    -- | Coerce a integer value to floating point
    coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
    coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
    coerceInt2FP Width
    width1 Width
    width2 CmmExpr
    x = do
        (Reg
    src, InstrBlock
    code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
        let
            code__2 :: Reg -> InstrBlock
    code__2 Reg
    dst = InstrBlock
    code InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL [
                Format -> Reg -> AddrMode -> Instr
    ST (Width -> Format
    intFormat Width
    width1) Reg
    src (Int -> AddrMode
    spRel (-Int
    2)),
                Format -> AddrMode -> Reg -> Instr
    LD (Width -> Format
    intFormat Width
    width1) (Int -> AddrMode
    spRel (-Int
    2)) Reg
    dst,
                Format -> Format -> Reg -> Reg -> Instr
    FxTOy (Width -> Format
    intFormat Width
    width1) (Width -> Format
    floatFormat Width
    width2) Reg
    dst Reg
    dst]
        Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any (Width -> Format
    floatFormat (Width -> Format) -> Width -> Format
    forall a b. (a -> b) -> a -> b
    $ Width
    width2) Reg -> InstrBlock
    code__2)

    -- | Coerce a floating point value to integer
    --
    --   NOTE: On sparc v9 there are no instructions to move a value from an
    --         FP register directly to an int register, so we have to use a load/store.
    --
    coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
    coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
    coerceFP2Int Width
    width1 Width
    width2 CmmExpr
    x
     = do   let fformat1 :: Format
    fformat1      = Width -> Format
    floatFormat Width
    width1
                fformat2 :: Format
    fformat2      = Width -> Format
    floatFormat Width
    width2

                iformat2 :: Format
    iformat2      = Width -> Format
    intFormat   Width
    width2

            (Reg
    fsrc, InstrBlock
    code)    <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
            Reg
    fdst            <- Format -> NatM Reg
    getNewRegNat Format
    fformat2

            let code2 :: Reg -> InstrBlock
    code2 Reg
    dst
                    =       InstrBlock
    code
                    InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL
                            -- convert float to int format, leaving it in a float reg.
                            [ Format -> Format -> Reg -> Reg -> Instr
    FxTOy Format
    fformat1 Format
    iformat2 Reg
    fsrc Reg
    fdst

                            -- store the int into mem, then load it back to move
                            --      it into an actual int reg.
                            , Format -> Reg -> AddrMode -> Instr
    ST    Format
    fformat2 Reg
    fdst (Int -> AddrMode
    spRel (-Int
    2))
                            , Format -> AddrMode -> Reg -> Instr
    LD    Format
    iformat2 (Int -> AddrMode
    spRel (-Int
    2)) Reg
    dst]

            Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    iformat2 Reg -> InstrBlock
    code2)

    -- | Coerce a double precision floating point value to single precision.
    coerceDbl2Flt :: CmmExpr -> NatM Register
    coerceDbl2Flt :: CmmExpr -> NatM Register
    coerceDbl2Flt CmmExpr
    x = do
        (Reg
    src, InstrBlock
    code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
        Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    FF32 (\Reg
    dst -> InstrBlock
    code InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Format -> Reg -> Reg -> Instr
    FxTOy Format
    FF64 Format
    FF32 Reg
    src Reg
    dst))

    -- | Coerce a single precision floating point value to double precision
    coerceFlt2Dbl :: CmmExpr -> NatM Register
    coerceFlt2Dbl :: CmmExpr -> NatM Register
    coerceFlt2Dbl CmmExpr
    x = do
        (Reg
    src, InstrBlock
    code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
        Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    FF64 (\Reg
    dst -> InstrBlock
    code InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Format -> Format -> Reg -> Reg -> Instr
    FxTOy Format
    FF32 Format
    FF64 Reg
    src Reg
    dst))

    -- Condition Codes -------------------------------------------------------------
    --
    -- Evaluate a comparison, and get the result into a register.
    --
    -- Do not fill the delay slots here. you will confuse the register allocator.
    --
    condIntReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
    condIntReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
    condIntReg Cond
    EQQ CmmExpr
    x (CmmLit (CmmInt Integer
    0 Width
    _)) = do
        (Reg
    src, InstrBlock
    code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
        let
            code__2 :: Reg -> InstrBlock
    code__2 Reg
    dst = InstrBlock
    code InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL [
                Bool -> Bool -> Reg -> RI -> Reg -> Instr
    SUB Bool
    False Bool
    True Reg
    g0 (Reg -> RI
    RIReg Reg
    src) Reg
    g0,
                Bool -> Bool -> Reg -> RI -> Reg -> Instr
    SUB Bool
    True Bool
    False Reg
    g0 (Imm -> RI
    RIImm (Int -> Imm
    ImmInt (-Int
    1))) Reg
    dst]
        Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    II32 Reg -> InstrBlock
    code__2)

    condIntReg Cond
    EQQ CmmExpr
    x CmmExpr
    y = do
        (Reg
    src1, InstrBlock
    code1) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
        (Reg
    src2, InstrBlock
    code2) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    y
        let
            code__2 :: Reg -> InstrBlock
    code__2 Reg
    dst = InstrBlock
    code1 InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` InstrBlock
    code2 InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL [
                Bool -> Reg -> RI -> Reg -> Instr
    XOR Bool
    False Reg
    src1 (Reg -> RI
    RIReg Reg
    src2) Reg
    dst,
                Bool -> Bool -> Reg -> RI -> Reg -> Instr
    SUB Bool
    False Bool
    True Reg
    g0 (Reg -> RI
    RIReg Reg
    dst) Reg
    g0,
                Bool -> Bool -> Reg -> RI -> Reg -> Instr
    SUB Bool
    True Bool
    False Reg
    g0 (Imm -> RI
    RIImm (Int -> Imm
    ImmInt (-Int
    1))) Reg
    dst]
        Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    II32 Reg -> InstrBlock
    code__2)

    condIntReg Cond
    NE CmmExpr
    x (CmmLit (CmmInt Integer
    0 Width
    _)) = do
        (Reg
    src, InstrBlock
    code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
        let
            code__2 :: Reg -> InstrBlock
    code__2 Reg
    dst = InstrBlock
    code InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL [
                Bool -> Bool -> Reg -> RI -> Reg -> Instr
    SUB Bool
    False Bool
    True Reg
    g0 (Reg -> RI
    RIReg Reg
    src) Reg
    g0,
                Bool -> Bool -> Reg -> RI -> Reg -> Instr
    ADD Bool
    True Bool
    False Reg
    g0 (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    0)) Reg
    dst]
        Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    II32 Reg -> InstrBlock
    code__2)

    condIntReg Cond
    NE CmmExpr
    x CmmExpr
    y = do
        (Reg
    src1, InstrBlock
    code1) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    x
        (Reg
    src2, InstrBlock
    code2) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    y
        let
            code__2 :: Reg -> InstrBlock
    code__2 Reg
    dst = InstrBlock
    code1 InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` InstrBlock
    code2 InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL [
                Bool -> Reg -> RI -> Reg -> Instr
    XOR Bool
    False Reg
    src1 (Reg -> RI
    RIReg Reg
    src2) Reg
    dst,
                Bool -> Bool -> Reg -> RI -> Reg -> Instr
    SUB Bool
    False Bool
    True Reg
    g0 (Reg -> RI
    RIReg Reg
    dst) Reg
    g0,
                Bool -> Bool -> Reg -> RI -> Reg -> Instr
    ADD Bool
    True Bool
    False Reg
    g0 (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    0)) Reg
    dst]
        Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    II32 Reg -> InstrBlock
    code__2)

    condIntReg Cond
    cond CmmExpr
    x CmmExpr
    y = do
        BlockId
    bid1 <- (BlockId -> BlockId) -> NatM BlockId -> NatM BlockId
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (\BlockId
    a -> BlockId -> BlockId -> BlockId
    seq BlockId
    a BlockId
    a) NatM BlockId
    getBlockIdNat
        BlockId
    bid2 <- (BlockId -> BlockId) -> NatM BlockId -> NatM BlockId
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (\BlockId
    a -> BlockId -> BlockId -> BlockId
    seq BlockId
    a BlockId
    a) NatM BlockId
    getBlockIdNat
        CondCode Bool
    _ Cond
    cond InstrBlock
    cond_code <- Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condIntCode Cond
    cond CmmExpr
    x CmmExpr
    y
        let
            code__2 :: Reg -> InstrBlock
    code__2 Reg
    dst
             =      InstrBlock
    cond_code
              InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL
                    [ Cond -> Bool -> BlockId -> Instr
    BI Cond
    cond Bool
    False BlockId
    bid1
                    , Instr
    NOP

                    , Bool -> Reg -> RI -> Reg -> Instr
    OR Bool
    False Reg
    g0 (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    0)) Reg
    dst
                    , Cond -> Bool -> BlockId -> Instr
    BI Cond
    ALWAYS Bool
    False BlockId
    bid2
                    , Instr
    NOP

                    , BlockId -> Instr
    NEWBLOCK BlockId
    bid1
                    , Bool -> Reg -> RI -> Reg -> Instr
    OR Bool
    False Reg
    g0 (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    1)) Reg
    dst
                    , Cond -> Bool -> BlockId -> Instr
    BI Cond
    ALWAYS Bool
    False BlockId
    bid2
                    , Instr
    NOP

                    , BlockId -> Instr
    NEWBLOCK BlockId
    bid2]

        Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    II32 Reg -> InstrBlock
    code__2)

    condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
    condFltReg Cond
    cond CmmExpr
    x CmmExpr
    y = do
        BlockId
    bid1 <- (BlockId -> BlockId) -> NatM BlockId -> NatM BlockId
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (\BlockId
    a -> BlockId -> BlockId -> BlockId
    seq BlockId
    a BlockId
    a) NatM BlockId
    getBlockIdNat
        BlockId
    bid2 <- (BlockId -> BlockId) -> NatM BlockId -> NatM BlockId
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (\BlockId
    a -> BlockId -> BlockId -> BlockId
    seq BlockId
    a BlockId
    a) NatM BlockId
    getBlockIdNat

        CondCode Bool
    _ Cond
    cond InstrBlock
    cond_code <- Cond -> CmmExpr -> CmmExpr -> NatM CondCode
    condFltCode Cond
    cond CmmExpr
    x CmmExpr
    y
        let
            code__2 :: Reg -> InstrBlock
    code__2 Reg
    dst
             =      InstrBlock
    cond_code
              InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL
                    [ Instr
    NOP
                    , Cond -> Bool -> BlockId -> Instr
    BF Cond
    cond Bool
    False BlockId
    bid1
                    , Instr
    NOP

                    , Bool -> Reg -> RI -> Reg -> Instr
    OR Bool
    False Reg
    g0 (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    0)) Reg
    dst
                    , Cond -> Bool -> BlockId -> Instr
    BI Cond
    ALWAYS Bool
    False BlockId
    bid2
                    , Instr
    NOP

                    , BlockId -> Instr
    NEWBLOCK BlockId
    bid1
                    , Bool -> Reg -> RI -> Reg -> Instr
    OR Bool
    False Reg
    g0 (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    1)) Reg
    dst
                    , Cond -> Bool -> BlockId -> Instr
    BI Cond
    ALWAYS Bool
    False BlockId
    bid2
                    , Instr
    NOP

                    , BlockId -> Instr
    NEWBLOCK BlockId
    bid2 ]

        Register -> NatM Register
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Format -> (Reg -> InstrBlock) -> Register
    Any Format
    II32 Reg -> InstrBlock
    code__2)