{-# LANGUAGE CPP #-}

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

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

        fpRelEA,
        moveSp,

        isUnconditionalJump,

        Instr(..),
        maxSpillSlots
)

where

import GhcPrelude

import SPARC.Stack
import SPARC.Imm
import SPARC.AddrMode
import SPARC.Cond
import SPARC.Regs
import SPARC.Base
import TargetReg
import Instruction
import RegClass
import Reg
import Format

import CLabel
import CodeGen.Platform
import BlockId
import DynFlags
import Cmm
import FastString
import Outputable
import 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 0))                       = Bool
True
riZero (RIImm (ImmInteger 0))                   = Bool
True
riZero (RIReg (RegReal (RealRegSingle 0)))      = Bool
True
riZero _                                        = Bool
False


-- | Calculate the effective address which would be used by the
--      corresponding fpRel sequence.
fpRelEA :: Int -> Reg -> Instr
fpRelEA :: Int -> Reg -> Instr
fpRelEA n :: Int
n dst :: 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 n :: 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 ii :: Instr
ii
 = case Instr
ii of
        CALL{}          -> Bool
True
        JMP{}           -> Bool
True
        JMP_TBL{}       -> Bool
True
        BI ALWAYS _ _   -> Bool
True
        BF ALWAYS _ _   -> Bool
True
        _               -> 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 :: DynFlags -> Reg -> Int -> Int -> Instr
mkSpillInstr            = DynFlags -> Reg -> Int -> Int -> Instr
sparc_mkSpillInstr
        mkLoadInstr :: DynFlags -> Reg -> Int -> Int -> Instr
mkLoadInstr             = DynFlags -> 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 "no sparc_mkStackAllocInstr"
        mkStackDeallocInstr :: Platform -> Int -> [Instr]
mkStackDeallocInstr     = String -> Platform -> Int -> [Instr]
forall a. String -> a
panic "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 CmmStatics

        -- 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
platform instr :: Instr
instr
 = case Instr
instr of
    LD    _ addr :: AddrMode
addr reg :: Reg
reg            -> ([Reg], [Reg]) -> RegUsage
usage (AddrMode -> [Reg]
regAddr AddrMode
addr,         [Reg
reg])
    ST    _ reg :: Reg
reg addr :: AddrMode
addr            -> ([Reg], [Reg]) -> RegUsage
usage (Reg
reg Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: AddrMode -> [Reg]
regAddr AddrMode
addr,   [])
    ADD   _ _ r1 :: Reg
r1 ar :: RI
ar r2 :: Reg
r2          -> ([Reg], [Reg]) -> RegUsage
usage (Reg
r1 Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: RI -> [Reg]
regRI RI
ar,        [Reg
r2])
    SUB   _ _ r1 :: Reg
r1 ar :: RI
ar r2 :: Reg
r2          -> ([Reg], [Reg]) -> RegUsage
usage (Reg
r1 Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: RI -> [Reg]
regRI RI
ar,        [Reg
r2])
    UMUL    _ r1 :: Reg
r1 ar :: RI
ar r2 :: Reg
r2          -> ([Reg], [Reg]) -> RegUsage
usage (Reg
r1 Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: RI -> [Reg]
regRI RI
ar,        [Reg
r2])
    SMUL    _ r1 :: Reg
r1 ar :: RI
ar r2 :: Reg
r2          -> ([Reg], [Reg]) -> RegUsage
usage (Reg
r1 Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: RI -> [Reg]
regRI RI
ar,        [Reg
r2])
    UDIV    _ r1 :: Reg
r1 ar :: RI
ar r2 :: Reg
r2          -> ([Reg], [Reg]) -> RegUsage
usage (Reg
r1 Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: RI -> [Reg]
regRI RI
ar,        [Reg
r2])
    SDIV    _ r1 :: Reg
r1 ar :: RI
ar r2 :: Reg
r2          -> ([Reg], [Reg]) -> RegUsage
usage (Reg
r1 Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: RI -> [Reg]
regRI RI
ar,        [Reg
r2])
    RDY       rd :: Reg
rd                -> ([Reg], [Reg]) -> RegUsage
usage ([],                   [Reg
rd])
    WRY       r1 :: Reg
r1 r2 :: Reg
r2             -> ([Reg], [Reg]) -> RegUsage
usage ([Reg
r1, Reg
r2],             [])
    AND     _ r1 :: Reg
r1 ar :: RI
ar r2 :: Reg
r2          -> ([Reg], [Reg]) -> RegUsage
usage (Reg
r1 Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: RI -> [Reg]
regRI RI
ar,        [Reg
r2])
    ANDN    _ r1 :: Reg
r1 ar :: RI
ar r2 :: Reg
r2          -> ([Reg], [Reg]) -> RegUsage
usage (Reg
r1 Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: RI -> [Reg]
regRI RI
ar,        [Reg
r2])
    OR      _ r1 :: Reg
r1 ar :: RI
ar r2 :: Reg
r2          -> ([Reg], [Reg]) -> RegUsage
usage (Reg
r1 Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: RI -> [Reg]
regRI RI
ar,        [Reg
r2])
    ORN     _ r1 :: Reg
r1 ar :: RI
ar r2 :: Reg
r2          -> ([Reg], [Reg]) -> RegUsage
usage (Reg
r1 Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: RI -> [Reg]
regRI RI
ar,        [Reg
r2])
    XOR     _ r1 :: Reg
r1 ar :: RI
ar r2 :: Reg
r2          -> ([Reg], [Reg]) -> RegUsage
usage (Reg
r1 Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: RI -> [Reg]
regRI RI
ar,        [Reg
r2])
    XNOR    _ r1 :: Reg
r1 ar :: RI
ar r2 :: Reg
r2          -> ([Reg], [Reg]) -> RegUsage
usage (Reg
r1 Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: RI -> [Reg]
regRI RI
ar,        [Reg
r2])
    SLL       r1 :: Reg
r1 ar :: RI
ar r2 :: Reg
r2          -> ([Reg], [Reg]) -> RegUsage
usage (Reg
r1 Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: RI -> [Reg]
regRI RI
ar,        [Reg
r2])
    SRL       r1 :: Reg
r1 ar :: RI
ar r2 :: Reg
r2          -> ([Reg], [Reg]) -> RegUsage
usage (Reg
r1 Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: RI -> [Reg]
regRI RI
ar,        [Reg
r2])
    SRA       r1 :: Reg
r1 ar :: RI
ar r2 :: Reg
r2          -> ([Reg], [Reg]) -> RegUsage
usage (Reg
r1 Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: RI -> [Reg]
regRI RI
ar,        [Reg
r2])
    SETHI   _ reg :: Reg
reg               -> ([Reg], [Reg]) -> RegUsage
usage ([],                   [Reg
reg])
    FABS    _ r1 :: Reg
r1 r2 :: Reg
r2             -> ([Reg], [Reg]) -> RegUsage
usage ([Reg
r1],                 [Reg
r2])
    FADD    _ r1 :: Reg
r1 r2 :: Reg
r2 r3 :: Reg
r3          -> ([Reg], [Reg]) -> RegUsage
usage ([Reg
r1, Reg
r2],             [Reg
r3])
    FCMP    _ _  r1 :: Reg
r1 r2 :: Reg
r2          -> ([Reg], [Reg]) -> RegUsage
usage ([Reg
r1, Reg
r2],             [])
    FDIV    _ r1 :: Reg
r1 r2 :: Reg
r2 r3 :: Reg
r3          -> ([Reg], [Reg]) -> RegUsage
usage ([Reg
r1, Reg
r2],             [Reg
r3])
    FMOV    _ r1 :: Reg
r1 r2 :: Reg
r2             -> ([Reg], [Reg]) -> RegUsage
usage ([Reg
r1],                 [Reg
r2])
    FMUL    _ r1 :: Reg
r1 r2 :: Reg
r2 r3 :: Reg
r3          -> ([Reg], [Reg]) -> RegUsage
usage ([Reg
r1, Reg
r2],             [Reg
r3])
    FNEG    _ r1 :: Reg
r1 r2 :: Reg
r2             -> ([Reg], [Reg]) -> RegUsage
usage ([Reg
r1],                 [Reg
r2])
    FSQRT   _ r1 :: Reg
r1 r2 :: Reg
r2             -> ([Reg], [Reg]) -> RegUsage
usage ([Reg
r1],                 [Reg
r2])
    FSUB    _ r1 :: Reg
r1 r2 :: Reg
r2 r3 :: Reg
r3          -> ([Reg], [Reg]) -> RegUsage
usage ([Reg
r1, Reg
r2],             [Reg
r3])
    FxTOy   _ _  r1 :: Reg
r1 r2 :: Reg
r2          -> ([Reg], [Reg]) -> RegUsage
usage ([Reg
r1],                 [Reg
r2])

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

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

  where
    usage :: ([Reg], [Reg]) -> RegUsage
usage (src :: [Reg]
src, dst :: [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 r1 :: Reg
r1 r2 :: Reg
r2)  = [Reg
r1, Reg
r2]
    regAddr (AddrRegImm r1 :: Reg
r1 _)   = [Reg
r1]

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


-- | Interesting regs are virtuals, or ones that are allocatable
--      by the register allocator.
interesting :: Platform -> Reg -> Bool
interesting :: Platform -> Reg -> Bool
interesting platform :: Platform
platform reg :: Reg
reg
 = case Reg
reg of
        RegVirtual _                    -> Bool
True
        RegReal (RealRegSingle r1 :: Int
r1)      -> Platform -> Int -> Bool
freeReg Platform
platform Int
r1
        RegReal (RealRegPair r1 :: Int
r1 _)      -> 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
instr env :: Reg -> Reg
env = case Instr
instr of
    LD    fmt :: Format
fmt addr :: AddrMode
addr reg :: Reg
reg          -> Format -> AddrMode -> Reg -> Instr
LD Format
fmt (AddrMode -> AddrMode
fixAddr AddrMode
addr) (Reg -> Reg
env Reg
reg)
    ST    fmt :: Format
fmt reg :: Reg
reg addr :: AddrMode
addr          -> Format -> Reg -> AddrMode -> Instr
ST Format
fmt (Reg -> Reg
env Reg
reg) (AddrMode -> AddrMode
fixAddr AddrMode
addr)

    ADD   x :: Bool
x cc :: Bool
cc r1 :: Reg
r1 ar :: RI
ar r2 :: 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   x :: Bool
x cc :: Bool
cc r1 :: Reg
r1 ar :: RI
ar r2 :: 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    cc :: Bool
cc r1 :: Reg
r1 ar :: RI
ar r2 :: 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    cc :: Bool
cc r1 :: Reg
r1 ar :: RI
ar r2 :: 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    cc :: Bool
cc r1 :: Reg
r1 ar :: RI
ar r2 :: 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    cc :: Bool
cc r1 :: Reg
r1 ar :: RI
ar r2 :: 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   rd :: Reg
rd                    -> Reg -> Instr
RDY         (Reg -> Reg
env Reg
rd)
    WRY   r1 :: Reg
r1 r2 :: Reg
r2                 -> Reg -> Reg -> Instr
WRY         (Reg -> Reg
env Reg
r1) (Reg -> Reg
env Reg
r2)
    AND   b :: Bool
b r1 :: Reg
r1 ar :: RI
ar r2 :: 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  b :: Bool
b r1 :: Reg
r1 ar :: RI
ar r2 :: 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    b :: Bool
b r1 :: Reg
r1 ar :: RI
ar r2 :: 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   b :: Bool
b r1 :: Reg
r1 ar :: RI
ar r2 :: 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   b :: Bool
b r1 :: Reg
r1 ar :: RI
ar r2 :: 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  b :: Bool
b r1 :: Reg
r1 ar :: RI
ar r2 :: 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   r1 :: Reg
r1 ar :: RI
ar r2 :: Reg
r2              -> Reg -> RI -> Reg -> Instr
SLL         (Reg -> Reg
env Reg
r1) (RI -> RI
fixRI RI
ar) (Reg -> Reg
env Reg
r2)
    SRL   r1 :: Reg
r1 ar :: RI
ar r2 :: Reg
r2              -> Reg -> RI -> Reg -> Instr
SRL         (Reg -> Reg
env Reg
r1) (RI -> RI
fixRI RI
ar) (Reg -> Reg
env Reg
r2)
    SRA   r1 :: Reg
r1 ar :: RI
ar r2 :: 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
imm reg :: Reg
reg               -> Imm -> Reg -> Instr
SETHI Imm
imm (Reg -> Reg
env Reg
reg)

    FABS  s :: Format
s r1 :: Reg
r1 r2 :: Reg
r2               -> Format -> Reg -> Reg -> Instr
FABS    Format
s   (Reg -> Reg
env Reg
r1) (Reg -> Reg
env Reg
r2)
    FADD  s :: Format
s r1 :: Reg
r1 r2 :: Reg
r2 r3 :: 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  e :: Bool
e s :: Format
s r1 :: Reg
r1 r2 :: Reg
r2             -> Bool -> Format -> Reg -> Reg -> Instr
FCMP Bool
e  Format
s   (Reg -> Reg
env Reg
r1) (Reg -> Reg
env Reg
r2)
    FDIV  s :: Format
s r1 :: Reg
r1 r2 :: Reg
r2 r3 :: 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  s :: Format
s r1 :: Reg
r1 r2 :: Reg
r2               -> Format -> Reg -> Reg -> Instr
FMOV    Format
s   (Reg -> Reg
env Reg
r1) (Reg -> Reg
env Reg
r2)
    FMUL  s :: Format
s r1 :: Reg
r1 r2 :: Reg
r2 r3 :: 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  s :: Format
s r1 :: Reg
r1 r2 :: Reg
r2               -> Format -> Reg -> Reg -> Instr
FNEG    Format
s   (Reg -> Reg
env Reg
r1) (Reg -> Reg
env Reg
r2)
    FSQRT s :: Format
s r1 :: Reg
r1 r2 :: Reg
r2               -> Format -> Reg -> Reg -> Instr
FSQRT   Format
s   (Reg -> Reg
env Reg
r1) (Reg -> Reg
env Reg
r2)
    FSUB  s :: Format
s r1 :: Reg
r1 r2 :: Reg
r2 r3 :: 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 s1 :: Format
s1 s2 :: Format
s2 r1 :: Reg
r1 r2 :: Reg
r2           -> Format -> Format -> Reg -> Reg -> Instr
FxTOy Format
s1 Format
s2 (Reg -> Reg
env Reg
r1) (Reg -> Reg
env Reg
r2)

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

    CALL  (Left i :: Imm
i) n :: Int
n t :: 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 r :: Reg
r) n :: Int
n t :: 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

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

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


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

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


sparc_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
sparc_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
sparc_patchJumpInstr insn :: Instr
insn patchF :: BlockId -> BlockId
patchF
  = case Instr
insn of
        BI cc :: Cond
cc annul :: Bool
annul id :: BlockId
id  -> Cond -> Bool -> BlockId -> Instr
BI Cond
cc Bool
annul (BlockId -> BlockId
patchF BlockId
id)
        BF cc :: Cond
cc annul :: Bool
annul id :: BlockId
id  -> Cond -> Bool -> BlockId -> Instr
BF Cond
cc Bool
annul (BlockId -> BlockId
patchF BlockId
id)
        JMP_TBL n :: AddrMode
n ids :: [Maybe BlockId]
ids l :: 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
insn


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

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

    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
    :: DynFlags
    -> Reg      -- ^ register to load into
    -> Int      -- ^ current stack delta
    -> Int      -- ^ spill slot to use
    -> Instr

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

        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
instr
 = case Instr
instr of
        DELTA i :: Int
i         -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        _               -> Maybe Int
forall a. Maybe a
Nothing


sparc_isMetaInstr
        :: Instr
        -> Bool

sparc_isMetaInstr :: Instr -> Bool
sparc_isMetaInstr instr :: Instr
instr
 = case Instr
instr of
        COMMENT{}       -> Bool
True
        LDATA{}         -> Bool
True
        NEWBLOCK{}      -> Bool
True
        DELTA{}         -> Bool
True
        _               -> 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
platform src :: Reg
src dst :: 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
                RcInteger -> Bool -> Bool -> Reg -> RI -> Reg -> Instr
ADD  Bool
False Bool
False Reg
src (Reg -> RI
RIReg Reg
g0) Reg
dst
                RcDouble  -> Format -> Reg -> Reg -> Instr
FMOV Format
FF64 Reg
src Reg
dst
                RcFloat   -> Format -> Reg -> Reg -> Instr
FMOV Format
FF32 Reg
src Reg
dst
                _         -> String -> Instr
forall a. String -> a
panic "sparc_mkRegRegMoveInstr"

        | Bool
otherwise
        = String -> Instr
forall a. String -> a
panic "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
instr
 = case Instr
instr of
        ADD False False src :: Reg
src (RIReg src2 :: Reg
src2) dst :: 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 FF64 src :: Reg
src dst :: Reg
dst       -> (Reg, Reg) -> Maybe (Reg, Reg)
forall a. a -> Maybe a
Just (Reg
src, Reg
dst)
        FMOV FF32  src :: Reg
src dst :: Reg
dst      -> (Reg, Reg) -> Maybe (Reg, Reg)
forall a. a -> Maybe a
Just (Reg
src, Reg
dst)
        _                       -> Maybe (Reg, Reg)
forall a. Maybe a
Nothing


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

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