    {-# LANGUAGE CPP #-}

    -----------------------------------------------------------------------------
    --
    -- Machine-dependent assembly language
    --
    -- (c) The University of Glasgow 1993-2004
    --
    -----------------------------------------------------------------------------
    #include "HsVersions.h"

    module GHC.CmmToAsm.SPARC.Instr (
            RI(..),
            riZero,

            fpRelEA,
            moveSp,

            isUnconditionalJump,

            Instr(..),
            maxSpillSlots
    )

    where

    import GHC.Prelude

    import GHC.CmmToAsm.SPARC.Stack
    import GHC.CmmToAsm.SPARC.Imm
    import GHC.CmmToAsm.SPARC.AddrMode
    import GHC.CmmToAsm.SPARC.Cond
    import GHC.CmmToAsm.SPARC.Regs
    import GHC.CmmToAsm.SPARC.Base
    import GHC.CmmToAsm.Reg.Target
    import GHC.CmmToAsm.Instr
    import GHC.Platform.Reg.Class
    import GHC.Platform.Reg
    import GHC.CmmToAsm.Format
    import GHC.CmmToAsm.Config

    import GHC.Cmm.CLabel
    import GHC.Platform.Regs
    import GHC.Cmm.BlockId
    import GHC.Cmm
    import GHC.Data.FastString
    import GHC.Utils.Outputable
    import GHC.Platform

    -- | Register or immediate
    data RI
            = RIReg Reg
            | RIImm Imm

    -- | Check if a RI represents a zero value.
    --      - a literal zero
    --      - register %g0, which is always zero.
    --
    riZero :: RI -> Bool
    riZero :: RI -> Bool
    riZero (RIImm (ImmInt Int
    0))                       = Bool
    True
    riZero (RIImm (ImmInteger Integer
    0))                   = Bool
    True
    riZero (RIReg (RegReal (RealRegSingle Int
    0)))      = Bool
    True
    riZero RI
    _                                        = Bool
    False

    -- | Calculate the effective address which would be used by the
    --      corresponding fpRel sequence.
    fpRelEA :: Int -> Reg -> Instr
    fpRelEA :: Int -> Reg -> Instr
    fpRelEA Int
    n Reg
    dst
       = Bool -> Bool -> Reg -> RI -> Reg -> Instr
    ADD Bool
    False Bool
    False Reg
    fp (Imm -> RI
    RIImm (Int -> Imm
    ImmInt (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    wordLength))) Reg
    dst

    -- | Code to shift the stack pointer by n words.
    moveSp :: Int -> Instr
    moveSp :: Int -> Instr
    moveSp Int
    n
       = Bool -> Bool -> Reg -> RI -> Reg -> Instr
    ADD Bool
    False Bool
    False Reg
    sp (Imm -> RI
    RIImm (Int -> Imm
    ImmInt (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    wordLength))) Reg
    sp

    -- | An instruction that will cause the one after it never to be exectuted
    isUnconditionalJump :: Instr -> Bool
    isUnconditionalJump :: Instr -> Bool
    isUnconditionalJump Instr
    ii
     = case Instr
    ii of
            CALL{}          -> Bool
    True
            JMP{}           -> Bool
    True
            JMP_TBL{}       -> Bool
    True
            BI Cond
    ALWAYS Bool
    _ BlockId
    _   -> Bool
    True
            BF Cond
    ALWAYS Bool
    _ BlockId
    _   -> Bool
    True
            Instr
    _               -> Bool
    False

    -- | instance for sparc instruction set
    instance Instruction Instr where
            regUsageOfInstr :: Platform -> Instr -> RegUsage
    regUsageOfInstr         = Platform -> Instr -> RegUsage
    sparc_regUsageOfInstr
            patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
    patchRegsOfInstr        = Instr -> (Reg -> Reg) -> Instr
    sparc_patchRegsOfInstr
            isJumpishInstr :: Instr -> Bool
    isJumpishInstr          = Instr -> Bool
    sparc_isJumpishInstr
            jumpDestsOfInstr :: Instr -> [BlockId]
    jumpDestsOfInstr        = Instr -> [BlockId]
    sparc_jumpDestsOfInstr
            patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
    patchJumpInstr          = Instr -> (BlockId -> BlockId) -> Instr
    sparc_patchJumpInstr
            mkSpillInstr :: NCGConfig -> Reg -> Int -> Int -> Instr
    mkSpillInstr            = NCGConfig -> Reg -> Int -> Int -> Instr
    sparc_mkSpillInstr
            mkLoadInstr :: NCGConfig -> Reg -> Int -> Int -> Instr
    mkLoadInstr             = NCGConfig -> Reg -> Int -> Int -> Instr
    sparc_mkLoadInstr
            takeDeltaInstr :: Instr -> Maybe Int
    takeDeltaInstr          = Instr -> Maybe Int
    sparc_takeDeltaInstr
            isMetaInstr :: Instr -> Bool
    isMetaInstr             = Instr -> Bool
    sparc_isMetaInstr
            mkRegRegMoveInstr :: Platform -> Reg -> Reg -> Instr
    mkRegRegMoveInstr       = Platform -> Reg -> Reg -> Instr
    sparc_mkRegRegMoveInstr
            takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg)
    takeRegRegMoveInstr     = Instr -> Maybe (Reg, Reg)
    sparc_takeRegRegMoveInstr
            mkJumpInstr :: BlockId -> [Instr]
    mkJumpInstr             = BlockId -> [Instr]
    sparc_mkJumpInstr
            mkStackAllocInstr :: Platform -> Int -> [Instr]
    mkStackAllocInstr       = String -> Platform -> Int -> [Instr]
    forall a. String -> a
    panic String
    "no sparc_mkStackAllocInstr"
            mkStackDeallocInstr :: Platform -> Int -> [Instr]
    mkStackDeallocInstr     = String -> Platform -> Int -> [Instr]
    forall a. String -> a
    panic String
    "no sparc_mkStackDeallocInstr"

    -- | SPARC instruction set.
    --      Not complete. This is only the ones we need.
    --
    data Instr

            -- meta ops --------------------------------------------------
            -- comment pseudo-op
            = COMMENT FastString

            -- some static data spat out during code generation.
            -- Will be extracted before pretty-printing.
            | LDATA   Section RawCmmStatics

            -- Start a new basic block.  Useful during codegen, removed later.
            -- Preceding instruction should be a jump, as per the invariants
            -- for a BasicBlock (see Cmm).
            | NEWBLOCK BlockId

            -- specify current stack offset for benefit of subsequent passes.
            | DELTA   Int

            -- real instrs -----------------------------------------------
            -- Loads and stores.
            | LD            Format AddrMode Reg             -- format, src, dst
            | ST            Format Reg AddrMode             -- format, src, dst

            -- Int Arithmetic.
            --      x:   add/sub with carry bit.
            --              In SPARC V9 addx and friends were renamed addc.
            --
            --      cc:  modify condition codes
            --
            | ADD           Bool Bool Reg RI Reg            -- x?, cc?, src1, src2, dst
            | SUB           Bool Bool Reg RI Reg            -- x?, cc?, src1, src2, dst

            | UMUL          Bool Reg RI Reg                 --     cc?, src1, src2, dst
            | SMUL          Bool Reg RI Reg                 --     cc?, src1, src2, dst

            -- The SPARC divide instructions perform 64bit by 32bit division
            --   The Y register is xored into the first operand.

            --   On _some implementations_ the Y register is overwritten by
            --   the remainder, so we have to make sure it is 0 each time.

            --   dst <- ((Y `shiftL` 32) `or` src1) `div` src2
            | UDIV          Bool Reg RI Reg                 --     cc?, src1, src2, dst
            | SDIV          Bool Reg RI Reg                 --     cc?, src1, src2, dst

            | RDY           Reg                             -- move contents of Y register to reg
            | WRY           Reg  Reg                        -- Y <- src1 `xor` src2

            -- Logic operations.
            | AND           Bool Reg RI Reg                 -- cc?, src1, src2, dst
            | ANDN          Bool Reg RI Reg                 -- cc?, src1, src2, dst
            | OR            Bool Reg RI Reg                 -- cc?, src1, src2, dst
            | ORN           Bool Reg RI Reg                 -- cc?, src1, src2, dst
            | XOR           Bool Reg RI Reg                 -- cc?, src1, src2, dst
            | XNOR          Bool Reg RI Reg                 -- cc?, src1, src2, dst
            | SLL           Reg RI Reg                      -- src1, src2, dst
            | SRL           Reg RI Reg                      -- src1, src2, dst
            | SRA           Reg RI Reg                      -- src1, src2, dst

            -- Load immediates.
            | SETHI         Imm Reg                         -- src, dst

            -- Do nothing.
            -- Implemented by the assembler as SETHI 0, %g0, but worth an alias
            | NOP

            -- Float Arithmetic.
            -- Note that we cheat by treating F{ABS,MOV,NEG} of doubles as single
            -- instructions right up until we spit them out.
            --
            | FABS          Format Reg Reg                  -- src dst
            | FADD          Format Reg Reg Reg              -- src1, src2, dst
            | FCMP          Bool Format Reg Reg             -- exception?, src1, src2, dst
            | FDIV          Format Reg Reg Reg              -- src1, src2, dst
            | FMOV          Format Reg Reg                  -- src, dst
            | FMUL          Format Reg Reg Reg              -- src1, src2, dst
            | FNEG          Format Reg Reg                  -- src, dst
            | FSQRT         Format Reg Reg                  -- src, dst
            | FSUB          Format Reg Reg Reg              -- src1, src2, dst
            | FxTOy         Format Format Reg Reg           -- src, dst

            -- Jumping around.
            | BI            Cond Bool BlockId               -- cond, annul?, target
            | BF            Cond Bool BlockId               -- cond, annul?, target

            | JMP           AddrMode                        -- target

            -- With a tabled jump we know all the possible destinations.
            -- We also need this info so we can work out what regs are live across the jump.
            --
            | JMP_TBL       AddrMode [Maybe BlockId] CLabel

            | CALL          (Either Imm Reg) Int Bool       -- target, args, terminal

    -- | regUsage returns the sets of src and destination registers used
    --      by a particular instruction.  Machine registers that are
    --      pre-allocated to stgRegs are filtered out, because they are
    --      uninteresting from a register allocation standpoint.  (We wouldn't
    --      want them to end up on the free list!)  As far as we are concerned,
    --      the fixed registers simply don't exist (for allocation purposes,
    --      anyway).

    --      regUsage doesn't need to do any trickery for jumps and such.  Just
    --      state precisely the regs read and written by that insn.  The
    --      consequences of control flow transfers, as far as register
    --      allocation goes, are taken care of by the register allocator.
    --
    sparc_regUsageOfInstr :: Platform -> Instr -> RegUsage
    sparc_regUsageOfInstr :: Platform -> Instr -> RegUsage
    sparc_regUsageOfInstr Platform
    platform Instr
    instr
     = case Instr
    instr of
        LD    Format
    _ AddrMode
    addr Reg
    reg            -> ([Reg], [Reg]) -> RegUsage
    usage (AddrMode -> [Reg]
    regAddr AddrMode
    addr,         [Reg
    reg])
        ST    Format
    _ Reg
    reg AddrMode
    addr            -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    reg Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : AddrMode -> [Reg]
    regAddr AddrMode
    addr,   [])
        ADD   Bool
    _ Bool
    _ Reg
    r1 RI
    ar Reg
    r2          -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    r1 Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ar,        [Reg
    r2])
        SUB   Bool
    _ Bool
    _ Reg
    r1 RI
    ar Reg
    r2          -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    r1 Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ar,        [Reg
    r2])
        UMUL    Bool
    _ Reg
    r1 RI
    ar Reg
    r2          -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    r1 Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ar,        [Reg
    r2])
        SMUL    Bool
    _ Reg
    r1 RI
    ar Reg
    r2          -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    r1 Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ar,        [Reg
    r2])
        UDIV    Bool
    _ Reg
    r1 RI
    ar Reg
    r2          -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    r1 Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ar,        [Reg
    r2])
        SDIV    Bool
    _ Reg
    r1 RI
    ar Reg
    r2          -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    r1 Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ar,        [Reg
    r2])
        RDY       Reg
    rd                -> ([Reg], [Reg]) -> RegUsage
    usage ([],                   [Reg
    rd])
        WRY       Reg
    r1 Reg
    r2             -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r1, Reg
    r2],             [])
        AND     Bool
    _ Reg
    r1 RI
    ar Reg
    r2          -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    r1 Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ar,        [Reg
    r2])
        ANDN    Bool
    _ Reg
    r1 RI
    ar Reg
    r2          -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    r1 Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ar,        [Reg
    r2])
        OR      Bool
    _ Reg
    r1 RI
    ar Reg
    r2          -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    r1 Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ar,        [Reg
    r2])
        ORN     Bool
    _ Reg
    r1 RI
    ar Reg
    r2          -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    r1 Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ar,        [Reg
    r2])
        XOR     Bool
    _ Reg
    r1 RI
    ar Reg
    r2          -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    r1 Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ar,        [Reg
    r2])
        XNOR    Bool
    _ Reg
    r1 RI
    ar Reg
    r2          -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    r1 Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ar,        [Reg
    r2])
        SLL       Reg
    r1 RI
    ar Reg
    r2          -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    r1 Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ar,        [Reg
    r2])
        SRL       Reg
    r1 RI
    ar Reg
    r2          -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    r1 Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ar,        [Reg
    r2])
        SRA       Reg
    r1 RI
    ar Reg
    r2          -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    r1 Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ar,        [Reg
    r2])
        SETHI   Imm
    _ Reg
    reg               -> ([Reg], [Reg]) -> RegUsage
    usage ([],                   [Reg
    reg])
        FABS    Format
    _ Reg
    r1 Reg
    r2             -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r1],                 [Reg
    r2])
        FADD    Format
    _ Reg
    r1 Reg
    r2 Reg
    r3          -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r1, Reg
    r2],             [Reg
    r3])
        FCMP    Bool
    _ Format
    _  Reg
    r1 Reg
    r2          -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r1, Reg
    r2],             [])
        FDIV    Format
    _ Reg
    r1 Reg
    r2 Reg
    r3          -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r1, Reg
    r2],             [Reg
    r3])
        FMOV    Format
    _ Reg
    r1 Reg
    r2             -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r1],                 [Reg
    r2])
        FMUL    Format
    _ Reg
    r1 Reg
    r2 Reg
    r3          -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r1, Reg
    r2],             [Reg
    r3])
        FNEG    Format
    _ Reg
    r1 Reg
    r2             -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r1],                 [Reg
    r2])
        FSQRT   Format
    _ Reg
    r1 Reg
    r2             -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r1],                 [Reg
    r2])
        FSUB    Format
    _ Reg
    r1 Reg
    r2 Reg
    r3          -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r1, Reg
    r2],             [Reg
    r3])
        FxTOy   Format
    _ Format
    _  Reg
    r1 Reg
    r2          -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r1],                 [Reg
    r2])

        JMP     AddrMode
    addr                -> ([Reg], [Reg]) -> RegUsage
    usage (AddrMode -> [Reg]
    regAddr AddrMode
    addr, [])
        JMP_TBL AddrMode
    addr [Maybe BlockId]
    _ CLabel
    _            -> ([Reg], [Reg]) -> RegUsage
    usage (AddrMode -> [Reg]
    regAddr AddrMode
    addr, [])

        CALL  (Left Imm
    _  )  Int
    _ Bool
    True    -> RegUsage
    noUsage
        CALL  (Left Imm
    _  )  Int
    n Bool
    False   -> ([Reg], [Reg]) -> RegUsage
    usage (Int -> [Reg]
    argRegs Int
    n, [Reg]
    callClobberedRegs)
        CALL  (Right Reg
    reg) Int
    _ Bool
    True    -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg], [])
        CALL  (Right Reg
    reg) Int
    n Bool
    False   -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    reg Reg -> [Reg] -> [Reg]
    forall a. a -> [a] -> [a]
    : (Int -> [Reg]
    argRegs Int
    n), [Reg]
    callClobberedRegs)
        Instr
    _                           -> RegUsage
    noUsage

      where
        usage :: ([Reg], [Reg]) -> RegUsage
    usage ([Reg]
    src, [Reg]
    dst)
         = [Reg] -> [Reg] -> RegUsage
    RU ((Reg -> Bool) -> [Reg] -> [Reg]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Platform -> Reg -> Bool
    interesting Platform
    platform) [Reg]
    src)
              ((Reg -> Bool) -> [Reg] -> [Reg]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Platform -> Reg -> Bool
    interesting Platform
    platform) [Reg]
    dst)

        regAddr :: AddrMode -> [Reg]
    regAddr (AddrRegReg Reg
    r1 Reg
    r2)  = [Reg
    r1, Reg
    r2]
        regAddr (AddrRegImm Reg
    r1 Imm
    _)   = [Reg
    r1]

        regRI :: RI -> [Reg]
    regRI (RIReg Reg
    r)             = [Reg
    r]
        regRI  RI
    _                    = []

    -- | Interesting regs are virtuals, or ones that are allocatable
    --      by the register allocator.
    interesting :: Platform -> Reg -> Bool
    interesting :: Platform -> Reg -> Bool
    interesting Platform
    platform Reg
    reg
     = case Reg
    reg of
            RegVirtual VirtualReg
    _                    -> Bool
    True
            RegReal (RealRegSingle Int
    r1)      -> Platform -> Int -> Bool
    freeReg Platform
    platform Int
    r1
            RegReal (RealRegPair Int
    r1 Int
    _)      -> Platform -> Int -> Bool
    freeReg Platform
    platform Int
    r1

    -- | Apply a given mapping to tall the register references in this instruction.
    sparc_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
    sparc_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
    sparc_patchRegsOfInstr Instr
    instr Reg -> Reg
    env = case Instr
    instr of
        LD    Format
    fmt AddrMode
    addr Reg
    reg          -> Format -> AddrMode -> Reg -> Instr
    LD Format
    fmt (AddrMode -> AddrMode
    fixAddr AddrMode
    addr) (Reg -> Reg
    env Reg
    reg)
        ST    Format
    fmt Reg
    reg AddrMode
    addr          -> Format -> Reg -> AddrMode -> Instr
    ST Format
    fmt (Reg -> Reg
    env Reg
    reg) (AddrMode -> AddrMode
    fixAddr AddrMode
    addr)

        ADD   Bool
    x Bool
    cc Reg
    r1 RI
    ar Reg
    r2         -> Bool -> Bool -> Reg -> RI -> Reg -> Instr
    ADD   Bool
    x Bool
    cc  (Reg -> Reg
    env Reg
    r1) (RI -> RI
    fixRI RI
    ar) (Reg -> Reg
    env Reg
    r2)
        SUB   Bool
    x Bool
    cc Reg
    r1 RI
    ar Reg
    r2         -> Bool -> Bool -> Reg -> RI -> Reg -> Instr
    SUB   Bool
    x Bool
    cc  (Reg -> Reg
    env Reg
    r1) (RI -> RI
    fixRI RI
    ar) (Reg -> Reg
    env Reg
    r2)
        UMUL    Bool
    cc Reg
    r1 RI
    ar Reg
    r2         -> Bool -> Reg -> RI -> Reg -> Instr
    UMUL    Bool
    cc  (Reg -> Reg
    env Reg
    r1) (RI -> RI
    fixRI RI
    ar) (Reg -> Reg
    env Reg
    r2)
        SMUL    Bool
    cc Reg
    r1 RI
    ar Reg
    r2         -> Bool -> Reg -> RI -> Reg -> Instr
    SMUL    Bool
    cc  (Reg -> Reg
    env Reg
    r1) (RI -> RI
    fixRI RI
    ar) (Reg -> Reg
    env Reg
    r2)
        UDIV    Bool
    cc Reg
    r1 RI
    ar Reg
    r2         -> Bool -> Reg -> RI -> Reg -> Instr
    UDIV    Bool
    cc  (Reg -> Reg
    env Reg
    r1) (RI -> RI
    fixRI RI
    ar) (Reg -> Reg
    env Reg
    r2)
        SDIV    Bool
    cc Reg
    r1 RI
    ar Reg
    r2         -> Bool -> Reg -> RI -> Reg -> Instr
    SDIV    Bool
    cc  (Reg -> Reg
    env Reg
    r1) (RI -> RI
    fixRI RI
    ar) (Reg -> Reg
    env Reg
    r2)
        RDY   Reg
    rd                    -> Reg -> Instr
    RDY         (Reg -> Reg
    env Reg
    rd)
        WRY   Reg
    r1 Reg
    r2                 -> Reg -> Reg -> Instr
    WRY         (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2)
        AND   Bool
    b Reg
    r1 RI
    ar Reg
    r2            -> Bool -> Reg -> RI -> Reg -> Instr
    AND   Bool
    b     (Reg -> Reg
    env Reg
    r1) (RI -> RI
    fixRI RI
    ar) (Reg -> Reg
    env Reg
    r2)
        ANDN  Bool
    b Reg
    r1 RI
    ar Reg
    r2            -> Bool -> Reg -> RI -> Reg -> Instr
    ANDN  Bool
    b     (Reg -> Reg
    env Reg
    r1) (RI -> RI
    fixRI RI
    ar) (Reg -> Reg
    env Reg
    r2)
        OR    Bool
    b Reg
    r1 RI
    ar Reg
    r2            -> Bool -> Reg -> RI -> Reg -> Instr
    OR    Bool
    b     (Reg -> Reg
    env Reg
    r1) (RI -> RI
    fixRI RI
    ar) (Reg -> Reg
    env Reg
    r2)
        ORN   Bool
    b Reg
    r1 RI
    ar Reg
    r2            -> Bool -> Reg -> RI -> Reg -> Instr
    ORN   Bool
    b     (Reg -> Reg
    env Reg
    r1) (RI -> RI
    fixRI RI
    ar) (Reg -> Reg
    env Reg
    r2)
        XOR   Bool
    b Reg
    r1 RI
    ar Reg
    r2            -> Bool -> Reg -> RI -> Reg -> Instr
    XOR   Bool
    b     (Reg -> Reg
    env Reg
    r1) (RI -> RI
    fixRI RI
    ar) (Reg -> Reg
    env Reg
    r2)
        XNOR  Bool
    b Reg
    r1 RI
    ar Reg
    r2            -> Bool -> Reg -> RI -> Reg -> Instr
    XNOR  Bool
    b     (Reg -> Reg
    env Reg
    r1) (RI -> RI
    fixRI RI
    ar) (Reg -> Reg
    env Reg
    r2)
        SLL   Reg
    r1 RI
    ar Reg
    r2              -> Reg -> RI -> Reg -> Instr
    SLL         (Reg -> Reg
    env Reg
    r1) (RI -> RI
    fixRI RI
    ar) (Reg -> Reg
    env Reg
    r2)
        SRL   Reg
    r1 RI
    ar Reg
    r2              -> Reg -> RI -> Reg -> Instr
    SRL         (Reg -> Reg
    env Reg
    r1) (RI -> RI
    fixRI RI
    ar) (Reg -> Reg
    env Reg
    r2)
        SRA   Reg
    r1 RI
    ar Reg
    r2              -> Reg -> RI -> Reg -> Instr
    SRA         (Reg -> Reg
    env Reg
    r1) (RI -> RI
    fixRI RI
    ar) (Reg -> Reg
    env Reg
    r2)

        SETHI Imm
    imm Reg
    reg               -> Imm -> Reg -> Instr
    SETHI Imm
    imm (Reg -> Reg
    env Reg
    reg)

        FABS  Format
    s Reg
    r1 Reg
    r2               -> Format -> Reg -> Reg -> Instr
    FABS    Format
    s   (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2)
        FADD  Format
    s Reg
    r1 Reg
    r2 Reg
    r3            -> Format -> Reg -> Reg -> Reg -> Instr
    FADD    Format
    s   (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2) (Reg -> Reg
    env Reg
    r3)
        FCMP  Bool
    e Format
    s Reg
    r1 Reg
    r2             -> Bool -> Format -> Reg -> Reg -> Instr
    FCMP Bool
    e  Format
    s   (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2)
        FDIV  Format
    s Reg
    r1 Reg
    r2 Reg
    r3            -> Format -> Reg -> Reg -> Reg -> Instr
    FDIV    Format
    s   (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2) (Reg -> Reg
    env Reg
    r3)
        FMOV  Format
    s Reg
    r1 Reg
    r2               -> Format -> Reg -> Reg -> Instr
    FMOV    Format
    s   (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2)
        FMUL  Format
    s Reg
    r1 Reg
    r2 Reg
    r3            -> Format -> Reg -> Reg -> Reg -> Instr
    FMUL    Format
    s   (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2) (Reg -> Reg
    env Reg
    r3)
        FNEG  Format
    s Reg
    r1 Reg
    r2               -> Format -> Reg -> Reg -> Instr
    FNEG    Format
    s   (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2)
        FSQRT Format
    s Reg
    r1 Reg
    r2               -> Format -> Reg -> Reg -> Instr
    FSQRT   Format
    s   (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2)
        FSUB  Format
    s Reg
    r1 Reg
    r2 Reg
    r3            -> Format -> Reg -> Reg -> Reg -> Instr
    FSUB    Format
    s   (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2) (Reg -> Reg
    env Reg
    r3)
        FxTOy Format
    s1 Format
    s2 Reg
    r1 Reg
    r2           -> Format -> Format -> Reg -> Reg -> Instr
    FxTOy Format
    s1 Format
    s2 (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2)

        JMP     AddrMode
    addr                -> AddrMode -> Instr
    JMP     (AddrMode -> AddrMode
    fixAddr AddrMode
    addr)
        JMP_TBL AddrMode
    addr [Maybe BlockId]
    ids CLabel
    l          -> AddrMode -> [Maybe BlockId] -> CLabel -> Instr
    JMP_TBL (AddrMode -> AddrMode
    fixAddr AddrMode
    addr) [Maybe BlockId]
    ids CLabel
    l

        CALL  (Left Imm
    i) Int
    n Bool
    t          -> Either Imm Reg -> Int -> Bool -> Instr
    CALL (Imm -> Either Imm Reg
    forall a b. a -> Either a b
    Left Imm
    i) Int
    n Bool
    t
        CALL  (Right Reg
    r) Int
    n Bool
    t         -> Either Imm Reg -> Int -> Bool -> Instr
    CALL (Reg -> Either Imm Reg
    forall a b. b -> Either a b
    Right (Reg -> Reg
    env Reg
    r)) Int
    n Bool
    t
        Instr
    _                           -> Instr
    instr

      where
        fixAddr :: AddrMode -> AddrMode
    fixAddr (AddrRegReg Reg
    r1 Reg
    r2)  = Reg -> Reg -> AddrMode
    AddrRegReg   (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2)
        fixAddr (AddrRegImm Reg
    r1 Imm
    i)   = Reg -> Imm -> AddrMode
    AddrRegImm   (Reg -> Reg
    env Reg
    r1) Imm
    i

        fixRI :: RI -> RI
    fixRI (RIReg Reg
    r)             = Reg -> RI
    RIReg (Reg -> Reg
    env Reg
    r)
        fixRI RI
    other                 = RI
    other

    --------------------------------------------------------------------------------
    sparc_isJumpishInstr :: Instr -> Bool
    sparc_isJumpishInstr :: Instr -> Bool
    sparc_isJumpishInstr Instr
    instr
     = case Instr
    instr of
            BI{}            -> Bool
    True
            BF{}            -> Bool
    True
            JMP{}           -> Bool
    True
            JMP_TBL{}       -> Bool
    True
            CALL{}          -> Bool
    True
            Instr
    _               -> Bool
    False

    sparc_jumpDestsOfInstr :: Instr -> [BlockId]
    sparc_jumpDestsOfInstr :: Instr -> [BlockId]
    sparc_jumpDestsOfInstr Instr
    insn
      = case Instr
    insn of
            BI   Cond
    _ Bool
    _ BlockId
    id     -> [BlockId
    id]
            BF   Cond
    _ Bool
    _ BlockId
    id     -> [BlockId
    id]
            JMP_TBL AddrMode
    _ [Maybe BlockId]
    ids CLabel
    _ -> [BlockId
    id | Just BlockId
    id <- [Maybe BlockId]
    ids]
            Instr
    _               -> []

    sparc_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
    sparc_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
    sparc_patchJumpInstr Instr
    insn BlockId -> BlockId
    patchF
      = case Instr
    insn of
            BI Cond
    cc Bool
    annul BlockId
    id  -> Cond -> Bool -> BlockId -> Instr
    BI Cond
    cc Bool
    annul (BlockId -> BlockId
    patchF BlockId
    id)
            BF Cond
    cc Bool
    annul BlockId
    id  -> Cond -> Bool -> BlockId -> Instr
    BF Cond
    cc Bool
    annul (BlockId -> BlockId
    patchF BlockId
    id)
            JMP_TBL AddrMode
    n [Maybe BlockId]
    ids CLabel
    l -> AddrMode -> [Maybe BlockId] -> CLabel -> Instr
    JMP_TBL AddrMode
    n ((Maybe BlockId -> Maybe BlockId)
    -> [Maybe BlockId] -> [Maybe BlockId]
    forall a b. (a -> b) -> [a] -> [b]
    map ((BlockId -> BlockId) -> Maybe BlockId -> Maybe BlockId
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap BlockId -> BlockId
    patchF) [Maybe BlockId]
    ids) CLabel
    l
            Instr
    _               -> Instr
    insn

    --------------------------------------------------------------------------------
    -- | Make a spill instruction.
    --      On SPARC we spill below frame pointer leaving 2 words/spill
    sparc_mkSpillInstr
        :: NCGConfig
        -> Reg      -- ^ register to spill
        -> Int      -- ^ current stack delta
        -> Int      -- ^ spill slot to use
        -> Instr

    sparc_mkSpillInstr :: NCGConfig -> Reg -> Int -> Int -> Instr
    sparc_mkSpillInstr NCGConfig
    config Reg
    reg Int
    _ Int
    slot
     = let  platform :: Platform
    platform = NCGConfig -> Platform
    ncgPlatform NCGConfig
    config
            off :: Int
    off      = NCGConfig -> Int -> Int
    spillSlotToOffset NCGConfig
    config Int
    slot
            off_w :: Int
    off_w    = Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    off Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    4)
            fmt :: Format
    fmt      = case Platform -> Reg -> RegClass
    targetClassOfReg Platform
    platform Reg
    reg of
                            RegClass
    RcInteger -> Format
    II32
                            RegClass
    RcFloat   -> Format
    FF32
                            RegClass
    RcDouble  -> Format
    FF64

        in Format -> Reg -> AddrMode -> Instr
    ST Format
    fmt Reg
    reg (Int -> AddrMode
    fpRel (Int -> Int
    forall a. Num a => a -> a
    negate Int
    off_w))

    -- | Make a spill reload instruction.
    sparc_mkLoadInstr
        :: NCGConfig
        -> Reg      -- ^ register to load into
        -> Int      -- ^ current stack delta
        -> Int      -- ^ spill slot to use
        -> Instr

    sparc_mkLoadInstr :: NCGConfig -> Reg -> Int -> Int -> Instr
    sparc_mkLoadInstr NCGConfig
    config Reg
    reg Int
    _ Int
    slot
      = let platform :: Platform
    platform = NCGConfig -> Platform
    ncgPlatform NCGConfig
    config
            off :: Int
    off      = NCGConfig -> Int -> Int
    spillSlotToOffset NCGConfig
    config Int
    slot
            off_w :: Int
    off_w    = Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    off Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    4)
            fmt :: Format
    fmt      = case Platform -> Reg -> RegClass
    targetClassOfReg Platform
    platform Reg
    reg of
                            RegClass
    RcInteger -> Format
    II32
                            RegClass
    RcFloat   -> Format
    FF32
                            RegClass
    RcDouble  -> Format
    FF64

            in Format -> AddrMode -> Reg -> Instr
    LD Format
    fmt (Int -> AddrMode
    fpRel (- Int
    off_w)) Reg
    reg

    --------------------------------------------------------------------------------
    -- | See if this instruction is telling us the current C stack delta
    sparc_takeDeltaInstr
            :: Instr
            -> Maybe Int

    sparc_takeDeltaInstr :: Instr -> Maybe Int
    sparc_takeDeltaInstr Instr
    instr
     = case Instr
    instr of
            DELTA Int
    i         -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    i
            Instr
    _               -> Maybe Int
    forall a. Maybe a
    Nothing

    sparc_isMetaInstr
            :: Instr
            -> Bool

    sparc_isMetaInstr :: Instr -> Bool
    sparc_isMetaInstr Instr
    instr
     = case Instr
    instr of
            COMMENT{}       -> Bool
    True
            LDATA{}         -> Bool
    True
            NEWBLOCK{}      -> Bool
    True
            DELTA{}         -> Bool
    True
            Instr
    _               -> Bool
    False

    -- | Make a reg-reg move instruction.
    --      On SPARC v8 there are no instructions to move directly between
    --      floating point and integer regs. If we need to do that then we
    --      have to go via memory.
    --
    sparc_mkRegRegMoveInstr
        :: Platform
        -> Reg
        -> Reg
        -> Instr

    sparc_mkRegRegMoveInstr :: Platform -> Reg -> Reg -> Instr
    sparc_mkRegRegMoveInstr Platform
    platform Reg
    src Reg
    dst
            | RegClass
    srcClass      <- Platform -> Reg -> RegClass
    targetClassOfReg Platform
    platform Reg
    src
            , RegClass
    dstClass      <- Platform -> Reg -> RegClass
    targetClassOfReg Platform
    platform Reg
    dst
            , RegClass
    srcClass RegClass -> RegClass -> Bool
    forall a. Eq a => a -> a -> Bool
    == RegClass
    dstClass
            = case RegClass
    srcClass of
                    RegClass
    RcInteger -> Bool -> Bool -> Reg -> RI -> Reg -> Instr
    ADD  Bool
    False Bool
    False Reg
    src (Reg -> RI
    RIReg Reg
    g0) Reg
    dst
                    RegClass
    RcDouble  -> Format -> Reg -> Reg -> Instr
    FMOV Format
    FF64 Reg
    src Reg
    dst
                    RegClass
    RcFloat   -> Format -> Reg -> Reg -> Instr
    FMOV Format
    FF32 Reg
    src Reg
    dst

            | Bool
    otherwise
            = String -> Instr
    forall a. String -> a
    panic String
    "SPARC.Instr.mkRegRegMoveInstr: classes of src and dest not the same"

    -- | Check whether an instruction represents a reg-reg move.
    --      The register allocator attempts to eliminate reg->reg moves whenever it can,
    --      by assigning the src and dest temporaries to the same real register.
    --
    sparc_takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)
    sparc_takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg)
    sparc_takeRegRegMoveInstr Instr
    instr
     = case Instr
    instr of
            ADD Bool
    False Bool
    False Reg
    src (RIReg Reg
    src2) Reg
    dst
             | Reg
    g0 Reg -> Reg -> Bool
    forall a. Eq a => a -> a -> Bool
    == Reg
    src2           -> (Reg, Reg) -> Maybe (Reg, Reg)
    forall a. a -> Maybe a
    Just (Reg
    src, Reg
    dst)

            FMOV Format
    FF64 Reg
    src Reg
    dst       -> (Reg, Reg) -> Maybe (Reg, Reg)
    forall a. a -> Maybe a
    Just (Reg
    src, Reg
    dst)
            FMOV Format
    FF32  Reg
    src Reg
    dst      -> (Reg, Reg) -> Maybe (Reg, Reg)
    forall a. a -> Maybe a
    Just (Reg
    src, Reg
    dst)
            Instr
    _                       -> Maybe (Reg, Reg)
    forall a. Maybe a
    Nothing

    -- | Make an unconditional branch instruction.
    sparc_mkJumpInstr
            :: BlockId
            -> [Instr]

    sparc_mkJumpInstr :: BlockId -> [Instr]
    sparc_mkJumpInstr BlockId
    id
     =       [Cond -> Bool -> BlockId -> Instr
    BI Cond
    ALWAYS Bool
    False BlockId
    id
            , Instr
    NOP]                  -- fill the branch delay slot.