From: Ben.Lippmeier@anu.edu.au Date: Mon, 16 Feb 2009 00:09:45 +0000 (+0000) Subject: SPARC NCG: Reorganise Reg and RegInfo X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=547bf6827f1fc3f2fb31bc6323cc0d33b445f32a SPARC NCG: Reorganise Reg and RegInfo --- diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 508615c..3c8c480 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -479,10 +479,14 @@ Library PPC.Cond PPC.Ppr PPC.CodeGen + SPARC.Base SPARC.Regs - SPARC.RegInfo - SPARC.Instr + SPARC.Imm + SPARC.AddrMode SPARC.Cond + SPARC.Instr + SPARC.Stack + SPARC.ShortcutJump SPARC.Ppr SPARC.CodeGen RegAlloc.Liveness diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index 4152c45..e0aa366 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -37,9 +37,9 @@ import X86.Ppr #elif sparc_TARGET_ARCH import SPARC.CodeGen import SPARC.Regs -import SPARC.RegInfo import SPARC.Instr import SPARC.Ppr +import SPARC.ShortcutJump #elif powerpc_TARGET_ARCH import PPC.CodeGen diff --git a/compiler/nativeGen/SPARC/AddrMode.hs b/compiler/nativeGen/SPARC/AddrMode.hs new file mode 100644 index 0000000..bd72cb3 --- /dev/null +++ b/compiler/nativeGen/SPARC/AddrMode.hs @@ -0,0 +1,42 @@ + +module SPARC.AddrMode ( + AddrMode(..), + addrOffset +) + +where + +import SPARC.Imm +import SPARC.Base +import Reg + +-- addressing modes ------------------------------------------------------------ + +-- | Represents a memory address in an instruction. +-- Being a RISC machine, the SPARC addressing modes are very regular. +-- +data AddrMode + = AddrRegReg Reg Reg -- addr = r1 + r2 + | AddrRegImm Reg Imm -- addr = r1 + imm + + +-- | Add an integer offset to the address in an AddrMode. +-- +addrOffset :: AddrMode -> Int -> Maybe AddrMode +addrOffset addr off + = case addr of + AddrRegImm r (ImmInt n) + | fits13Bits n2 -> Just (AddrRegImm r (ImmInt n2)) + | otherwise -> Nothing + where n2 = n + off + + AddrRegImm r (ImmInteger n) + | fits13Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2))) + | otherwise -> Nothing + where n2 = n + toInteger off + + AddrRegReg r (RealReg 0) + | fits13Bits off -> Just (AddrRegImm r (ImmInt off)) + | otherwise -> Nothing + + _ -> Nothing diff --git a/compiler/nativeGen/SPARC/Base.hs b/compiler/nativeGen/SPARC/Base.hs new file mode 100644 index 0000000..1549ab5 --- /dev/null +++ b/compiler/nativeGen/SPARC/Base.hs @@ -0,0 +1,51 @@ + +-- | Bits and pieces on the bottom of the module dependency tree. +-- Also import the required constants, so we know what we're using. +-- +-- In the interests of cross-compilation, we want to free ourselves +-- from the autoconf generated modules like main/Constants +-- +module SPARC.Base ( + wordLength, + wordLengthInBits, + spillAreaLength, + spillSlotSize, + fits13Bits, + largeOffsetError +) + +where + +import qualified Constants +import Panic + +-- On 32 bit SPARC, pointers are 32 bits. +wordLength :: Int +wordLength = 4 + +wordLengthInBits :: Int +wordLengthInBits + = wordLength * 8 + +-- Size of the available spill area +spillAreaLength :: Int +spillAreaLength + = Constants.rESERVED_C_STACK_BYTES + +-- | We need 8 bytes because our largest registers are 64 bit. +spillSlotSize :: Int +spillSlotSize = 8 + + +{-# SPECIALIZE fits13Bits :: Int -> Bool, Integer -> Bool #-} +-- | Check whether an offset is representable with 13 bits. +fits13Bits :: Integral a => a -> Bool +fits13Bits x = x >= -4096 && x < 4096 + + +-- | Sadness. +largeOffsetError :: Integral a => a -> b +largeOffsetError i + = panic ("ERROR: SPARC native-code generator cannot handle large offset (" + ++ show i ++ ");\nprobably because of large constant data structures;" ++ + "\nworkaround: use -fvia-C on this module.\n") diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs index d921c12..ff9a8ff 100644 --- a/compiler/nativeGen/SPARC/CodeGen.hs +++ b/compiler/nativeGen/SPARC/CodeGen.hs @@ -20,9 +20,12 @@ where -- NCG stuff: import SPARC.Instr +import SPARC.Stack import SPARC.Cond +import SPARC.Imm +import SPARC.AddrMode import SPARC.Regs -import SPARC.RegInfo +import SPARC.Base import Instruction import Size import Reg diff --git a/compiler/nativeGen/SPARC/Imm.hs b/compiler/nativeGen/SPARC/Imm.hs new file mode 100644 index 0000000..7ed30fd --- /dev/null +++ b/compiler/nativeGen/SPARC/Imm.hs @@ -0,0 +1,71 @@ + +module SPARC.Imm ( + -- immediate values + Imm(..), + strImmLit, + litToImm +) + +where + +import Cmm +import CLabel +import BlockId + +import Pretty +import Panic + +-- | An immediate value. +-- Not all of these are directly representable by the machine. +-- Things like ImmLit are slurped out and put in a data segment instead. +-- +data Imm + = ImmInt Int + + -- Sigh. + | ImmInteger Integer + + -- AbstractC Label (with baggage) + | ImmCLbl CLabel + + -- Simple string + | ImmLit Doc + | ImmIndex CLabel Int + | ImmFloat Rational + | ImmDouble Rational + + | ImmConstantSum Imm Imm + | ImmConstantDiff Imm Imm + + | LO Imm + | HI Imm + + +-- | Create a ImmLit containing this string. +strImmLit :: String -> Imm +strImmLit s = ImmLit (text s) + + +-- | Convert a CmmLit to an Imm. +-- Narrow to the width: a CmmInt might be out of +-- range, but we assume that ImmInteger only contains +-- in-range values. A signed value should be fine here. +-- +litToImm :: CmmLit -> Imm +litToImm lit + = case lit of + CmmInt i w -> ImmInteger (narrowS w i) + CmmFloat f W32 -> ImmFloat f + CmmFloat f W64 -> ImmDouble f + CmmLabel l -> ImmCLbl l + CmmLabelOff l off -> ImmIndex l off + + CmmLabelDiffOff l1 l2 off + -> ImmConstantSum + (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2)) + (ImmInt off) + + CmmBlock id -> ImmCLbl (infoTblLbl id) + _ -> panic "SPARC.Regs.litToImm: no match" + + diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs index 6dc6477..6c7af5b 100644 --- a/compiler/nativeGen/SPARC/Instr.hs +++ b/compiler/nativeGen/SPARC/Instr.hs @@ -11,14 +11,23 @@ module SPARC.Instr ( RI(..), + riZero, + + fpRelEA, + moveSp, + Instr(..), maxSpillSlots ) where -import SPARC.Regs +import SPARC.Stack +import SPARC.Imm +import SPARC.AddrMode import SPARC.Cond +import SPARC.Regs +import SPARC.Base import Instruction import RegClass import Reg @@ -26,8 +35,6 @@ import Size import BlockId import Cmm -import Outputable -import Constants (rESERVED_C_STACK_BYTES ) import FastString import FastBool @@ -39,6 +46,29 @@ 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 (RealReg 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 + -- | instance for sparc instruction set instance Instruction Instr where @@ -347,29 +377,6 @@ sparc_mkLoadInstr reg _ slot 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 diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs index a0d5fff..00ee07f 100644 --- a/compiler/nativeGen/SPARC/Ppr.hs +++ b/compiler/nativeGen/SPARC/Ppr.hs @@ -24,9 +24,11 @@ where #include "nativeGen/NCG.h" import SPARC.Regs -import SPARC.RegInfo import SPARC.Instr import SPARC.Cond +import SPARC.Imm +import SPARC.AddrMode +import SPARC.Base import Instruction import Reg import Size diff --git a/compiler/nativeGen/SPARC/RegInfo.hs b/compiler/nativeGen/SPARC/RegInfo.hs deleted file mode 100644 index 025e302..0000000 --- a/compiler/nativeGen/SPARC/RegInfo.hs +++ /dev/null @@ -1,129 +0,0 @@ - ------------------------------------------------------------------------------ --- --- Machine-specific parts of the register allocator --- --- (c) The University of Glasgow 1996-2004 --- ------------------------------------------------------------------------------ - -module SPARC.RegInfo ( - mkVReg, - - riZero, - fpRelEA, - moveSp, - fPair, - - shortcutStatic, - regDotColor, - - JumpDest(..), - canShortcut, - shortcutJump, -) - -where - -import SPARC.Instr -import SPARC.Regs -import RegClass -import Reg -import Size - -import Constants (wORD_SIZE) -import Cmm -import CLabel -import BlockId -import Outputable -import Unique - - --- | Make a virtual reg with this size. -mkVReg :: Unique -> Size -> Reg -mkVReg u size - | not (isFloatSize size) - = VirtualRegI u - - | otherwise - = case size of - FF32 -> VirtualRegF u - FF64 -> VirtualRegD u - _ -> panic "mkVReg" - - --- | 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 (RealReg 0)) = True -riZero _ = False - - --- | Calculate the effective address which would be used by the --- corresponding fpRel sequence. fpRel is in MachRegs.lhs, --- alas -- can't have fpRelEA here because of module dependencies. -fpRelEA :: Int -> Reg -> Instr -fpRelEA n dst - = ADD False False fp (RIImm (ImmInt (n * wORD_SIZE))) dst - - --- | Code to shift the stack pointer by n words. -moveSp :: Int -> Instr -moveSp n - = ADD False False sp (RIImm (ImmInt (n * wORD_SIZE))) sp - - --- | Produce the second-half-of-a-double register given the first half. -fPair :: Reg -> Maybe Reg -fPair (RealReg n) - | n >= 32 && n `mod` 2 == 0 = Just (RealReg (n+1)) - -fPair (VirtualRegD u) - = Just (VirtualRegHi u) - -fPair _ - = trace ("MachInstrs.fPair: can't get high half of supposed double reg ") - Nothing - --- Here because it knows about JumpDest -shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic -shortcutStatic fn (CmmStaticLit (CmmLabel lab)) - | Just uq <- maybeAsmTemp lab - = CmmStaticLit (CmmLabel (shortBlockId fn (BlockId uq))) -shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off)) - | Just uq <- maybeAsmTemp lbl1 - = CmmStaticLit (CmmLabelDiffOff (shortBlockId fn (BlockId uq)) lbl2 off) - -- slightly dodgy, we're ignoring the second label, but this - -- works with the way we use CmmLabelDiffOff for jump tables now. -shortcutStatic _ other_static - = other_static - -shortBlockId :: (BlockId -> Maybe JumpDest) -> BlockId -> CLabel -shortBlockId fn blockid@(BlockId uq) = - case fn blockid of - Nothing -> mkAsmTempLabel uq - Just (DestBlockId blockid') -> shortBlockId fn blockid' - Just (DestImm (ImmCLbl lbl)) -> lbl - _other -> panic "shortBlockId" - - -regDotColor :: Reg -> SDoc -regDotColor reg - = case regClass reg of - RcInteger -> text "blue" - RcFloat -> text "red" - RcDouble -> text "green" - - - -data JumpDest = DestBlockId BlockId | DestImm Imm - -canShortcut :: Instr -> Maybe JumpDest -canShortcut _ = Nothing - -shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr -shortcutJump _ other = other diff --git a/compiler/nativeGen/SPARC/Regs.hs b/compiler/nativeGen/SPARC/Regs.hs index 1fb6a01..7677dd5 100644 --- a/compiler/nativeGen/SPARC/Regs.hs +++ b/compiler/nativeGen/SPARC/Regs.hs @@ -5,38 +5,31 @@ -- ----------------------------------------------------------------------------- module SPARC.Regs ( - -- immediate values - Imm(..), - strImmLit, - litToImm, - - -- addressing modes - AddrMode(..), - addrOffset, - -- registers - spRel, - argRegs, - allArgRegs, - callClobberedRegs, - allMachRegNos, - regClass, showReg, + regClass, + allMachRegNos, -- machine specific info - fpRel, - fits13Bits, - largeOffsetError, gReg, iReg, lReg, oReg, fReg, fp, sp, g0, g1, g2, o0, o1, f0, f6, f8, f22, f26, f27, nCG_FirstFloatReg, + fPair, -- allocatable freeReg, allocatableRegs, globalRegMaybe, + get_GlobalReg_reg_or_addr, + + -- args + argRegs, + allArgRegs, + callClobberedRegs, - get_GlobalReg_reg_or_addr + -- + mkVReg, + regDotColor ) where @@ -44,164 +37,40 @@ where import Reg import RegClass +import Size +import Cmm import CgUtils ( get_GlobalReg_addr ) import BlockId -import Cmm -import CLabel ( CLabel ) -import Pretty -import Outputable ( panic ) -import qualified Outputable +import CLabel import Constants -import FastBool - - --- immediates ------------------------------------------------------------------ - --- | An immediate value. --- Not all of these are directly representable by the machine. --- Things like ImmLit are slurped out and put in a data segment instead. --- -data Imm - = ImmInt Int - - -- Sigh. - | ImmInteger Integer - - -- AbstractC Label (with baggage) - | ImmCLbl CLabel - - -- Simple string - | ImmLit Doc - | ImmIndex CLabel Int - | ImmFloat Rational - | ImmDouble Rational - - | ImmConstantSum Imm Imm - | ImmConstantDiff Imm Imm - - | LO Imm - | HI Imm - - --- | Create a ImmLit containing this string. -strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) - - --- | Convert a CmmLit to an Imm. --- Narrow to the width: a CmmInt might be out of --- range, but we assume that ImmInteger only contains --- in-range values. A signed value should be fine here. --- -litToImm :: CmmLit -> Imm -litToImm lit - = case lit of - CmmInt i w -> ImmInteger (narrowS w i) - CmmFloat f W32 -> ImmFloat f - CmmFloat f W64 -> ImmDouble f - CmmLabel l -> ImmCLbl l - CmmLabelOff l off -> ImmIndex l off - - CmmLabelDiffOff l1 l2 off - -> ImmConstantSum - (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2)) - (ImmInt off) - - CmmBlock id -> ImmCLbl (infoTblLbl id) - _ -> panic "SPARC.Regs.litToImm: no match" - - - --- addressing modes ------------------------------------------------------------ - --- | Represents a memory address in an instruction. --- Being a RISC machine, the SPARC addressing modes are very regular. --- -data AddrMode - = AddrRegReg Reg Reg -- addr = r1 + r2 - | AddrRegImm Reg Imm -- addr = r1 + imm - - --- | Add an integer offset to the address in an AddrMode. --- -addrOffset :: AddrMode -> Int -> Maybe AddrMode -addrOffset addr off - = case addr of - AddrRegImm r (ImmInt n) - | fits13Bits n2 -> Just (AddrRegImm r (ImmInt n2)) - | otherwise -> Nothing - where n2 = n + off - - AddrRegImm r (ImmInteger n) - | fits13Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2))) - | otherwise -> Nothing - where n2 = n + toInteger off - - AddrRegReg r (RealReg 0) - | fits13Bits off -> Just (AddrRegImm r (ImmInt off)) - | otherwise -> Nothing - - _ -> Nothing - - - --- registers ------------------------------------------------------------------- - --- | Get an AddrMode relative to the address in sp. --- This gives us a stack relative addressing mode for volatile --- temporaries and for excess call arguments. --- -spRel :: Int -- ^ stack offset in words, positive or negative - -> AddrMode - -spRel n = AddrRegImm sp (ImmInt (n * wORD_SIZE)) - - --- | The registers to place arguments for function calls, --- for some number of arguments. --- -argRegs :: RegNo -> [Reg] -argRegs r - = case r of - 0 -> [] - 1 -> map (RealReg . oReg) [0] - 2 -> map (RealReg . oReg) [0,1] - 3 -> map (RealReg . oReg) [0,1,2] - 4 -> map (RealReg . oReg) [0,1,2,3] - 5 -> map (RealReg . oReg) [0,1,2,3,4] - 6 -> map (RealReg . oReg) [0,1,2,3,4,5] - _ -> panic "MachRegs.argRegs(sparc): don't know about >6 arguments!" +import Unique +import Outputable +import FastBool --- | All all the regs that could possibly be returned by argRegs --- -allArgRegs :: [Reg] -allArgRegs - = map RealReg [oReg i | i <- [0..5]] +{- + The SPARC has 64 registers of interest; 32 integer registers and 32 + floating point registers. The mapping of STG registers to SPARC + machine registers is defined in StgRegs.h. We are, of course, + prepared for any eventuality. --- These are the regs that we cannot assume stay alive over a C call. --- TODO: Why can we assume that o6 isn't clobbered? -- BL 2009/02 --- -callClobberedRegs :: [Reg] -callClobberedRegs - = map RealReg - ( oReg 7 : - [oReg i | i <- [0..5]] ++ - [gReg i | i <- [1..7]] ++ - [fReg i | i <- [0..31]] ) + The whole fp-register pairing thing on sparcs is a huge nuisance. See + fptools/ghc/includes/MachRegs.h for a description of what's going on + here. +-} --- | The RegNos corresponding to all the registers in the machine. --- For SPARC we use f0-f22 as doubles, so pretend that the high halves --- of these, ie f23, f25 .. don't exist. --- -allMachRegNos :: [RegNo] -allMachRegNos - = ([0..31] - ++ [32,34 .. nCG_FirstFloatReg-1] - ++ [nCG_FirstFloatReg .. 63]) +-- | Get the standard name for the register with this number. +showReg :: RegNo -> String +showReg n + | n >= 0 && n < 8 = "%g" ++ show n + | n >= 8 && n < 16 = "%o" ++ show (n-8) + | n >= 16 && n < 24 = "%l" ++ show (n-16) + | n >= 24 && n < 32 = "%i" ++ show (n-24) + | n >= 32 && n < 64 = "%f" ++ show (n-32) + | otherwise = panic "SPARC.Regs.showReg: unknown sparc register" -- | Get the class of a register. @@ -219,53 +88,15 @@ regClass reg | otherwise -> RcFloat --- | Get the standard name for the register with this number. -showReg :: RegNo -> String -showReg n - | n >= 0 && n < 8 = "%g" ++ show n - | n >= 8 && n < 16 = "%o" ++ show (n-8) - | n >= 16 && n < 24 = "%l" ++ show (n-16) - | n >= 24 && n < 32 = "%i" ++ show (n-24) - | n >= 32 && n < 64 = "%f" ++ show (n-32) - | otherwise = panic "SPARC.Regs.showReg: unknown sparc register" - - --- machine specific ------------------------------------------------------------ - --- | Get an address relative to the frame pointer. --- This doesn't work work for offsets greater than 13 bits; we just hope for the best +-- | The RegNos corresponding to all the registers in the machine. +-- For SPARC we use f0-f22 as doubles, so pretend that the high halves +-- of these, ie f23, f25 .. don't exist. -- -fpRel :: Int -> AddrMode -fpRel n - = AddrRegImm fp (ImmInt (n * wORD_SIZE)) - - --- | Check whether an offset is representable with 13 bits. -fits13Bits :: Integral a => a -> Bool -fits13Bits x = x >= -4096 && x < 4096 - -{-# SPECIALIZE fits13Bits :: Int -> Bool, Integer -> Bool #-} - - --- | Sadness. -largeOffsetError :: Integral a => a -> b -largeOffsetError i - = panic ("ERROR: SPARC native-code generator cannot handle large offset (" - ++ show i ++ ");\nprobably because of large constant data structures;" ++ - "\nworkaround: use -fvia-C on this module.\n") - - - -{- - The SPARC has 64 registers of interest; 32 integer registers and 32 - floating point registers. The mapping of STG registers to SPARC - machine registers is defined in StgRegs.h. We are, of course, - prepared for any eventuality. - - The whole fp-register pairing thing on sparcs is a huge nuisance. See - fptools/ghc/includes/MachRegs.h for a description of what's going on - here. --} +allMachRegNos :: [RegNo] +allMachRegNos + = ([0..31] + ++ [32,34 .. nCG_FirstFloatReg-1] + ++ [nCG_FirstFloatReg .. 63]) -- | Get the regno for this sort of reg @@ -306,6 +137,18 @@ nCG_FirstFloatReg :: RegNo nCG_FirstFloatReg = 54 +-- | Produce the second-half-of-a-double register given the first half. +fPair :: Reg -> Maybe Reg +fPair (RealReg n) + | n >= 32 && n `mod` 2 == 0 = Just (RealReg (n+1)) + +fPair (VirtualRegD u) + = Just (VirtualRegHi u) + +fPair _ + = trace ("MachInstrs.fPair: can't get high half of supposed double reg ") + Nothing + -- | Check whether a machine register is free for allocation. -- This needs to match the info in includes/MachRegs.h otherwise modules @@ -442,3 +285,60 @@ get_GlobalReg_reg_or_addr mid = case globalRegMaybe mid of Just rr -> Left rr Nothing -> Right (get_GlobalReg_addr mid) + + +-- | The registers to place arguments for function calls, +-- for some number of arguments. +-- +argRegs :: RegNo -> [Reg] +argRegs r + = case r of + 0 -> [] + 1 -> map (RealReg . oReg) [0] + 2 -> map (RealReg . oReg) [0,1] + 3 -> map (RealReg . oReg) [0,1,2] + 4 -> map (RealReg . oReg) [0,1,2,3] + 5 -> map (RealReg . oReg) [0,1,2,3,4] + 6 -> map (RealReg . oReg) [0,1,2,3,4,5] + _ -> panic "MachRegs.argRegs(sparc): don't know about >6 arguments!" + + +-- | All all the regs that could possibly be returned by argRegs +-- +allArgRegs :: [Reg] +allArgRegs + = map RealReg [oReg i | i <- [0..5]] + + +-- These are the regs that we cannot assume stay alive over a C call. +-- TODO: Why can we assume that o6 isn't clobbered? -- BL 2009/02 +-- +callClobberedRegs :: [Reg] +callClobberedRegs + = map RealReg + ( oReg 7 : + [oReg i | i <- [0..5]] ++ + [gReg i | i <- [1..7]] ++ + [fReg i | i <- [0..31]] ) + + + +-- | Make a virtual reg with this size. +mkVReg :: Unique -> Size -> Reg +mkVReg u size + | not (isFloatSize size) + = VirtualRegI u + + | otherwise + = case size of + FF32 -> VirtualRegF u + FF64 -> VirtualRegD u + _ -> panic "mkVReg" + + +regDotColor :: Reg -> SDoc +regDotColor reg + = case regClass reg of + RcInteger -> text "blue" + RcFloat -> text "red" + RcDouble -> text "green" diff --git a/compiler/nativeGen/SPARC/ShortcutJump.hs b/compiler/nativeGen/SPARC/ShortcutJump.hs new file mode 100644 index 0000000..f560f82 --- /dev/null +++ b/compiler/nativeGen/SPARC/ShortcutJump.hs @@ -0,0 +1,61 @@ + +module SPARC.ShortcutJump ( + JumpDest(..), + canShortcut, + shortcutJump, + shortcutStatic, + shortBlockId +) + +where + +import SPARC.Instr +import SPARC.Imm + +import CLabel +import BlockId +import Cmm + +import Panic + + + +data JumpDest + = DestBlockId BlockId + | DestImm Imm + + +canShortcut :: Instr -> Maybe JumpDest +canShortcut _ = Nothing + + +shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr +shortcutJump _ other = other + + +shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic + +shortcutStatic fn (CmmStaticLit (CmmLabel lab)) + | Just uq <- maybeAsmTemp lab + = CmmStaticLit (CmmLabel (shortBlockId fn (BlockId uq))) + +shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off)) + | Just uq <- maybeAsmTemp lbl1 + = CmmStaticLit (CmmLabelDiffOff (shortBlockId fn (BlockId uq)) lbl2 off) + +-- slightly dodgy, we're ignoring the second label, but this +-- works with the way we use CmmLabelDiffOff for jump tables now. +shortcutStatic _ other_static + = other_static + + +shortBlockId :: (BlockId -> Maybe JumpDest) -> BlockId -> CLabel +shortBlockId fn blockid@(BlockId uq) = + case fn blockid of + Nothing -> mkAsmTempLabel uq + Just (DestBlockId blockid') -> shortBlockId fn blockid' + Just (DestImm (ImmCLbl lbl)) -> lbl + _other -> panic "shortBlockId" + + + diff --git a/compiler/nativeGen/SPARC/Stack.hs b/compiler/nativeGen/SPARC/Stack.hs new file mode 100644 index 0000000..0c19181 --- /dev/null +++ b/compiler/nativeGen/SPARC/Stack.hs @@ -0,0 +1,58 @@ + +module SPARC.Stack ( + spRel, + fpRel, + spillSlotToOffset, + maxSpillSlots +) + +where + +import SPARC.AddrMode +import SPARC.Regs +import SPARC.Base +import SPARC.Imm + +import Outputable + +-- | Get an AddrMode relative to the address in sp. +-- This gives us a stack relative addressing mode for volatile +-- temporaries and for excess call arguments. +-- +spRel :: Int -- ^ stack offset in words, positive or negative + -> AddrMode + +spRel n = AddrRegImm sp (ImmInt (n * wordLength)) + + +-- | Get an address relative to the frame pointer. +-- This doesn't work work for offsets greater than 13 bits; we just hope for the best +-- +fpRel :: Int -> AddrMode +fpRel n + = AddrRegImm fp (ImmInt (n * wordLength)) + + +-- | 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) + + +-- | The maximum number of spill slots available on the C stack. +-- If we use up all of the slots, then we're screwed. +-- +-- Why do we reserve 64 bytes, instead of using the whole thing?? +-- -- BL 2009/02/15 +-- +maxSpillSlots :: Int +maxSpillSlots + = ((spillAreaLength - 64) `div` spillSlotSize) - 1 + diff --git a/compiler/nativeGen/TargetReg.hs b/compiler/nativeGen/TargetReg.hs index 2643b00..471ee21 100644 --- a/compiler/nativeGen/TargetReg.hs +++ b/compiler/nativeGen/TargetReg.hs @@ -39,8 +39,6 @@ import qualified PPC.RegInfo as PPC #elif sparc_TARGET_ARCH import qualified SPARC.Regs as SPARC -import qualified SPARC.RegInfo as SPARC - #else #error "RegAlloc.Graph.TargetReg: not defined"