X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FSPARC%2FInstr.hs;h=93f4d274449863580de3c6997f82577caca99f1e;hb=86add45dbfb6f962b65e371143dd467ae783f9e7;hp=6dc6477f9c5bf7bb4c868a739178c6cda25c51b9;hpb=b04a210e26ca57242fd052f2aa91011a80b76299;p=ghc-hetmet.git diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs index 6dc6477..93f4d27 100644 --- a/compiler/nativeGen/SPARC/Instr.hs +++ b/compiler/nativeGen/SPARC/Instr.hs @@ -11,27 +11,38 @@ module SPARC.Instr ( RI(..), + riZero, + + fpRelEA, + moveSp, + + isUnconditionalJump, + Instr(..), maxSpillSlots ) where -import SPARC.Regs +import SPARC.Stack +import SPARC.Imm +import SPARC.AddrMode import SPARC.Cond +import SPARC.Regs +import SPARC.RegPlate +import SPARC.Base +import TargetReg import Instruction import RegClass import Reg import Size +import CLabel import BlockId -import Cmm -import Outputable -import Constants (rESERVED_C_STACK_BYTES ) +import OldCmm import FastString import FastBool - -import GHC.Exts +import Outputable -- | Register or immediate @@ -39,6 +50,40 @@ 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 (RIImm (ImmInt 0)) = True +riZero (RIImm (ImmInteger 0)) = True +riZero (RIReg (RegReal (RealRegSingle 0))) = True +riZero _ = False + + +-- | Calculate the effective address which would be used by the +-- corresponding fpRel sequence. +fpRelEA :: Int -> Reg -> Instr +fpRelEA n dst + = ADD False False fp (RIImm (ImmInt (n * wordLength))) dst + + +-- | Code to shift the stack pointer by n words. +moveSp :: Int -> Instr +moveSp n + = ADD False False sp (RIImm (ImmInt (n * wordLength))) sp + +-- | An instruction that will cause the one after it never to be exectuted +isUnconditionalJump :: Instr -> Bool +isUnconditionalJump ii + = case ii of + CALL{} -> True + JMP{} -> True + JMP_TBL{} -> True + BI ALWAYS _ _ -> True + BF ALWAYS _ _ -> True + _ -> False + -- | instance for sparc instruction set instance Instruction Instr where @@ -83,6 +128,11 @@ data Instr | ST Size Reg AddrMode -- size, 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 @@ -145,7 +195,7 @@ data Instr -- 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 [BlockId] + | JMP_TBL AddrMode [Maybe BlockId] CLabel | CALL (Either Imm Reg) Int Bool -- target, args, terminal @@ -198,7 +248,7 @@ sparc_regUsageOfInstr instr FxTOy _ _ r1 r2 -> usage ([r1], [r2]) JMP addr -> usage (regAddr addr, []) - JMP_TBL addr _ -> usage (regAddr addr, []) + JMP_TBL addr _ _ -> usage (regAddr addr, []) CALL (Left _ ) _ True -> noUsage CALL (Left _ ) n False -> usage (argRegs n, callClobberedRegs) @@ -222,11 +272,9 @@ sparc_regUsageOfInstr instr interesting :: Reg -> Bool interesting reg = case reg of - VirtualRegI _ -> True - VirtualRegHi _ -> True - VirtualRegF _ -> True - VirtualRegD _ -> True - RealReg i -> isFastTrue (freeReg i) + RegVirtual _ -> True + RegReal (RealRegSingle r1) -> isFastTrue (freeReg r1) + RegReal (RealRegPair r1 _) -> isFastTrue (freeReg r1) @@ -268,7 +316,7 @@ sparc_patchRegsOfInstr instr env = case instr of FxTOy s1 s2 r1 r2 -> FxTOy s1 s2 (env r1) (env r2) JMP addr -> JMP (fixAddr addr) - JMP_TBL addr ids -> JMP_TBL (fixAddr addr) ids + JMP_TBL addr ids l -> JMP_TBL (fixAddr addr) ids l CALL (Left i) n t -> CALL (Left i) n t CALL (Right r) n t -> CALL (Right (env r)) n t @@ -298,7 +346,7 @@ sparc_jumpDestsOfInstr insn = case insn of BI _ _ id -> [id] BF _ _ id -> [id] - JMP_TBL _ ids -> ids + JMP_TBL _ ids _ -> [id | Just id <- ids] _ -> [] @@ -307,6 +355,7 @@ sparc_patchJumpInstr insn patchF = case insn of BI cc annul id -> BI cc annul (patchF id) BF cc annul id -> BF cc annul (patchF id) + JMP_TBL n ids l -> JMP_TBL n (map (fmap patchF) ids) l _ -> insn @@ -322,17 +371,18 @@ sparc_mkSpillInstr sparc_mkSpillInstr reg _ slot = let off = spillSlotToOffset slot off_w = 1 + (off `div` 4) - sz = case regClass reg of + sz = case targetClassOfReg reg of RcInteger -> II32 RcFloat -> FF32 RcDouble -> FF64 + _ -> panic "sparc_mkSpillInstr" in ST sz reg (fpRel (negate off_w)) -- | Make a spill reload instruction. sparc_mkLoadInstr - :: Reg -- ^ register to load + :: Reg -- ^ register to load into -> Int -- ^ current stack delta -> Int -- ^ spill slot to use -> Instr @@ -340,36 +390,14 @@ sparc_mkLoadInstr sparc_mkLoadInstr reg _ slot = let off = spillSlotToOffset slot off_w = 1 + (off `div` 4) - sz = case regClass reg of + sz = case targetClassOfReg reg of RcInteger -> II32 RcFloat -> FF32 RcDouble -> FF64 + _ -> panic "sparc_mkLoadInstr" in LD sz (fpRel (- off_w)) reg --- | Convert a spill slot number to a *byte* offset, with no sign. --- -spillSlotToOffset :: Int -> Int -spillSlotToOffset slot - | slot >= 0 && slot < maxSpillSlots - = 64 + spillSlotSize * slot - - | otherwise - = pprPanic "spillSlotToOffset:" - ( text "invalid spill location: " <> int slot - $$ text "maxSpillSlots: " <> int maxSpillSlots) - - --- | We need 8 bytes because our largest registers are 64 bit. -spillSlotSize :: Int -spillSlotSize = 8 - - --- | The maximum number of spill slots available on the C stack. --- If we use up all of the slots, then we're screwed. -maxSpillSlots :: Int -maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1 - -------------------------------------------------------------------------------- -- | See if this instruction is telling us the current C stack delta @@ -407,10 +435,17 @@ sparc_mkRegRegMoveInstr -> Instr sparc_mkRegRegMoveInstr src dst - = case regClass src of - RcInteger -> ADD False False src (RIReg g0) dst - RcDouble -> FMOV FF64 src dst - RcFloat -> FMOV FF32 src dst + | srcClass <- targetClassOfReg src + , dstClass <- targetClassOfReg dst + , srcClass == dstClass + = case srcClass of + RcInteger -> ADD False False src (RIReg g0) dst + RcDouble -> FMOV FF64 src dst + RcFloat -> FMOV FF32 src dst + _ -> panic "sparc_mkRegRegMoveInstr" + + | otherwise + = panic "SPARC.Instr.mkRegRegMoveInstr: classes of src and dest not the same" -- | Check whether an instruction represents a reg-reg move.