{-# LANGUAGE CPP #-}

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

module GHC.CmmToAsm.SPARC.Instr
   ( Instr(..)
   , RI(..)
   , riZero
   , fpRelEA
   , moveSp
   , isUnconditionalJump
   , maxSpillSlots
   , patchRegsOfInstr
   , patchJumpInstr
   , mkRegRegMoveInstr
   , mkLoadInstr
   , mkSpillInstr
   , mkJumpInstr
   , takeDeltaInstr
   , isMetaInstr
   , isJumpishInstr
   , jumpDestsOfInstr
   , takeRegRegMoveInstr
   , regUsageOfInstr
   )
where

import GHC.Prelude
import GHC.Platform

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.Format
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Instr (RegUsage(..), noUsage)

import GHC.Platform.Reg.Class
import GHC.Platform.Reg
import GHC.Platform.Regs

import GHC.Cmm.CLabel
import GHC.Cmm.BlockId
import GHC.Cmm
import GHC.Data.FastString
import GHC.Utils.Panic


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


-- | 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.
--
regUsageOfInstr :: Platform -> Instr -> RegUsage
regUsageOfInstr :: Platform -> Instr -> RegUsage
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.
patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
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


--------------------------------------------------------------------------------
isJumpishInstr :: Instr -> Bool
isJumpishInstr :: Instr -> Bool
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

jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr :: Instr -> [BlockId]
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
_               -> []


patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
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
mkSpillInstr
    :: NCGConfig
    -> Reg      -- ^ register to spill
    -> Int      -- ^ current stack delta
    -> Int      -- ^ spill slot to use
    -> [Instr]

mkSpillInstr :: NCGConfig -> Reg -> Int -> Int -> [Instr]
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.
mkLoadInstr
    :: NCGConfig
    -> Reg      -- ^ register to load into
    -> Int      -- ^ current stack delta
    -> Int      -- ^ spill slot to use
    -> [Instr]

mkLoadInstr :: NCGConfig -> Reg -> Int -> Int -> [Instr]
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
takeDeltaInstr
        :: Instr
        -> Maybe Int

takeDeltaInstr :: Instr -> Maybe Int
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


isMetaInstr
        :: Instr
        -> Bool

isMetaInstr :: Instr -> Bool
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.
--
mkRegRegMoveInstr
    :: Platform
    -> Reg
    -> Reg
    -> Instr

mkRegRegMoveInstr :: Platform -> Reg -> Reg -> Instr
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.
--
takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)
takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg)
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.
mkJumpInstr
        :: BlockId
        -> [Instr]

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