X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FSPARC%2FRegs.hs;h=1c41e888ae63c45b1ad395f00c09126a20a6e925;hp=1fb6a01b879d0ab0d2c52eaef08e710f8604b979;hb=f9288086f935c97812b2d80defcff38baf7b6a6c;hpb=b04a210e26ca57242fd052f2aa91011a80b76299 diff --git a/compiler/nativeGen/SPARC/Regs.hs b/compiler/nativeGen/SPARC/Regs.hs index 1fb6a01..1c41e88 100644 --- a/compiler/nativeGen/SPARC/Regs.hs +++ b/compiler/nativeGen/SPARC/Regs.hs @@ -5,157 +5,228 @@ -- ----------------------------------------------------------------------------- module SPARC.Regs ( - -- immediate values - Imm(..), - strImmLit, - litToImm, - - -- addressing modes - AddrMode(..), - addrOffset, - -- registers - spRel, - argRegs, - allArgRegs, - callClobberedRegs, - allMachRegNos, - regClass, showReg, + virtualRegSqueeze, + realRegSqueeze, + classOfRealReg, + allRealRegs, -- 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, + fp, sp, g0, g1, g2, o0, o1, f0, f1, f6, f8, f22, f26, f27, -- allocatable - freeReg, allocatableRegs, - globalRegMaybe, + get_GlobalReg_reg_or_addr, + + -- args + argRegs, + allArgRegs, + callClobberedRegs, - get_GlobalReg_reg_or_addr + -- + mkVirtualReg, + regDotColor ) where +import SPARC.RegPlate import Reg import RegClass +import Size -import CgUtils ( get_GlobalReg_addr ) -import BlockId import Cmm -import CLabel ( CLabel ) -import Pretty -import Outputable ( panic ) -import qualified Outputable -import Constants -import FastBool +import PprCmm () +import CgUtils ( get_GlobalReg_addr ) +import Unique +import Outputable +import FastTypes +import FastBool --- immediates ------------------------------------------------------------------ +{- + 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. --- | 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 + 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. +-} - -- Sigh. - | ImmInteger Integer - -- AbstractC Label (with baggage) - | ImmCLbl CLabel +-- | 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" - -- Simple string - | ImmLit Doc - | ImmIndex CLabel Int - | ImmFloat Rational - | ImmDouble Rational - | ImmConstantSum Imm Imm - | ImmConstantDiff Imm Imm +-- Get the register class of a certain real reg +classOfRealReg :: RealReg -> RegClass +classOfRealReg reg + = case reg of + RealRegSingle i + | i < 32 -> RcInteger + | otherwise -> RcFloat + + RealRegPair{} -> RcDouble - | LO Imm - | HI Imm +-- | regSqueeze_class reg +-- Calculuate the maximum number of register colors that could be +-- denied to a node of this class due to having this reg +-- as a neighbour. +-- +{-# INLINE virtualRegSqueeze #-} +virtualRegSqueeze :: RegClass -> VirtualReg -> FastInt + +virtualRegSqueeze cls vr + = case cls of + RcInteger + -> case vr of + VirtualRegI{} -> _ILIT(1) + VirtualRegHi{} -> _ILIT(1) + VirtualRegF{} -> _ILIT(0) + VirtualRegD{} -> _ILIT(0) + + RcFloat + -> case vr of + VirtualRegI{} -> _ILIT(0) + VirtualRegHi{} -> _ILIT(0) + VirtualRegF{} -> _ILIT(1) + VirtualRegD{} -> _ILIT(2) + + RcDouble + -> case vr of + VirtualRegI{} -> _ILIT(0) + VirtualRegHi{} -> _ILIT(0) + VirtualRegF{} -> _ILIT(1) + VirtualRegD{} -> _ILIT(1) + +{-# INLINE realRegSqueeze #-} +realRegSqueeze :: RegClass -> RealReg -> FastInt + +realRegSqueeze cls rr + = case cls of + RcInteger + -> case rr of + RealRegSingle regNo + | regNo < 32 -> _ILIT(1) + | otherwise -> _ILIT(0) + + RealRegPair{} -> _ILIT(0) + + RcFloat + -> case rr of + RealRegSingle regNo + | regNo < 32 -> _ILIT(0) + | otherwise -> _ILIT(1) + + RealRegPair{} -> _ILIT(2) + + RcDouble + -> case rr of + RealRegSingle regNo + | regNo < 32 -> _ILIT(0) + | otherwise -> _ILIT(1) + + RealRegPair{} -> _ILIT(1) + + +-- | All the allocatable registers in the machine, +-- including register pairs. +allRealRegs :: [RealReg] +allRealRegs + = [ (RealRegSingle i) | i <- [0..63] ] + ++ [ (RealRegPair i (i+1)) | i <- [32, 34 .. 62 ] ] --- | Create a ImmLit containing this string. -strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +-- | Get the regno for this sort of reg +gReg, lReg, iReg, oReg, fReg :: Int -> RegNo --- | 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 +gReg x = x -- global regs +oReg x = (8 + x) -- output regs +lReg x = (16 + x) -- local regs +iReg x = (24 + x) -- input regs +fReg x = (32 + x) -- float regs - CmmLabelDiffOff l1 l2 off - -> ImmConstantSum - (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2)) - (ImmInt off) - CmmBlock id -> ImmCLbl (infoTblLbl id) - _ -> panic "SPARC.Regs.litToImm: no match" +-- | Some specific regs used by the code generator. +g0, g1, g2, fp, sp, o0, o1, f0, f1, f6, f8, f22, f26, f27 :: Reg +f6 = RegReal (RealRegSingle (fReg 6)) +f8 = RegReal (RealRegSingle (fReg 8)) +f22 = RegReal (RealRegSingle (fReg 22)) +f26 = RegReal (RealRegSingle (fReg 26)) +f27 = RegReal (RealRegSingle (fReg 27)) +-- g0 is always zero, and writes to it vanish. +g0 = RegReal (RealRegSingle (gReg 0)) +g1 = RegReal (RealRegSingle (gReg 1)) +g2 = RegReal (RealRegSingle (gReg 2)) --- addressing modes ------------------------------------------------------------ +-- FP, SP, int and float return (from C) regs. +fp = RegReal (RealRegSingle (iReg 6)) +sp = RegReal (RealRegSingle (oReg 6)) +o0 = RegReal (RealRegSingle (oReg 0)) +o1 = RegReal (RealRegSingle (oReg 1)) +f0 = RegReal (RealRegSingle (fReg 0)) +f1 = RegReal (RealRegSingle (fReg 1)) + +-- | 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)) --- | 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 +fPair (VirtualRegD u) + = Just (VirtualRegHi u) +fPair reg + = trace ("MachInstrs.fPair: can't get high half of supposed double reg " ++ showPpr reg) + Nothing +-} --- | 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 +-- | All the regs that the register allocator can allocate to, +-- with the the fixed use regs removed. +-- +allocatableRegs :: [RealReg] +allocatableRegs + = let isFree rr + = case rr of + RealRegSingle r + -> isFastTrue (freeReg r) - AddrRegReg r (RealReg 0) - | fits13Bits off -> Just (AddrRegImm r (ImmInt off)) - | otherwise -> Nothing - - _ -> Nothing + RealRegPair r1 r2 + -> isFastTrue (freeReg r1) + && isFastTrue (freeReg r2) + in filter isFree allRealRegs --- 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 +-- We map STG registers onto appropriate CmmExprs. Either they map +-- to real machine registers or stored as offsets from BaseReg. Given +-- a GlobalReg, get_GlobalReg_reg_or_addr produces either the real +-- register it is in, on this platform, or a CmmExpr denoting the +-- address in the register table holding it. +-- (See also get_GlobalReg_addr in CgUtils.) -spRel n = AddrRegImm sp (ImmInt (n * wORD_SIZE)) +get_GlobalReg_reg_or_addr :: GlobalReg -> Either RealReg CmmExpr +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, @@ -165,12 +236,12 @@ 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] + 1 -> map (RegReal . RealRegSingle . oReg) [0] + 2 -> map (RegReal . RealRegSingle . oReg) [0,1] + 3 -> map (RegReal . RealRegSingle . oReg) [0,1,2] + 4 -> map (RegReal . RealRegSingle . oReg) [0,1,2,3] + 5 -> map (RegReal . RealRegSingle . oReg) [0,1,2,3,4] + 6 -> map (RegReal . RealRegSingle . oReg) [0,1,2,3,4,5] _ -> panic "MachRegs.argRegs(sparc): don't know about >6 arguments!" @@ -178,7 +249,7 @@ argRegs r -- allArgRegs :: [Reg] allArgRegs - = map RealReg [oReg i | i <- [0..5]] + = map (RegReal . RealRegSingle) [oReg i | i <- [0..5]] -- These are the regs that we cannot assume stay alive over a C call. @@ -186,131 +257,46 @@ allArgRegs -- callClobberedRegs :: [Reg] callClobberedRegs - = map RealReg + = map (RegReal . RealRegSingle) ( oReg 7 : [oReg i | i <- [0..5]] ++ [gReg i | i <- [1..7]] ++ [fReg i | i <- [0..31]] ) --- | 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]) +-- | Make a virtual reg with this size. +mkVirtualReg :: Unique -> Size -> VirtualReg +mkVirtualReg u size + | not (isFloatSize size) + = VirtualRegI u --- | Get the class of a register. -{-# INLINE regClass #-} -regClass :: Reg -> RegClass -regClass reg - = case reg of - VirtualRegI _ -> RcInteger - VirtualRegHi _ -> RcInteger - VirtualRegF _ -> RcFloat - VirtualRegD _ -> RcDouble - RealReg i - | i < 32 -> RcInteger - | i < nCG_FirstFloatReg -> RcDouble - | otherwise -> RcFloat + | otherwise + = case size of + FF32 -> VirtualRegF u + FF64 -> VirtualRegD u + _ -> panic "mkVReg" --- | 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 --- -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. --} +regDotColor :: RealReg -> SDoc +regDotColor reg + = case classOfRealReg reg of + RcInteger -> text "blue" + RcFloat -> text "red" + RcDouble -> text "green" --- | Get the regno for this sort of reg -gReg, lReg, iReg, oReg, fReg :: Int -> RegNo - -gReg x = x -- global regs -oReg x = (8 + x) -- output regs -lReg x = (16 + x) -- local regs -iReg x = (24 + x) -- input regs -fReg x = (32 + x) -- float regs - - --- | Some specific regs used by the code generator. -g0, g1, g2, fp, sp, o0, o1, f0, f6, f8, f22, f26, f27 :: Reg - -f6 = RealReg (fReg 6) -f8 = RealReg (fReg 8) -f22 = RealReg (fReg 22) -f26 = RealReg (fReg 26) -f27 = RealReg (fReg 27) - -g0 = RealReg (gReg 0) -- g0 is always zero, and writes to it vanish. -g1 = RealReg (gReg 1) -g2 = RealReg (gReg 2) - --- FP, SP, int and float return (from C) regs. -fp = RealReg (iReg 6) -sp = RealReg (oReg 6) -o0 = RealReg (oReg 0) -o1 = RealReg (oReg 1) -f0 = RealReg (fReg 0) - - --- | We use he first few float regs as double precision. --- This is the RegNo of the first float regs we use as single precision. --- -nCG_FirstFloatReg :: RegNo -nCG_FirstFloatReg = 54 - +-- Hard coded freeReg / globalRegMaybe ----------------------------------------- +-- This isn't being used at the moment because we're generating +-- these functions from the information in includes/MachRegs.hs via RegPlate.hs + -- | Check whether a machine register is free for allocation. -- This needs to match the info in includes/MachRegs.h otherwise modules -- compiled with the NCG won't be compatible with via-C ones. -- +{- freeReg :: RegNo -> FastBool freeReg regno = case regno of @@ -348,12 +334,14 @@ freeReg regno -- %l6(r22) - %l7(r23) are allocable -------------- -- %i0(r24) - %i5(r29) - -- are STG regs Sp, Base, SpLim, Hp, HpLim, R6 + -- are STG regs Sp, Base, SpLim, Hp, R6 24 -> fastBool False 25 -> fastBool False 26 -> fastBool False 27 -> fastBool False - 28 -> fastBool False + + -- %i5(r28) is allocable -------------------------- + 29 -> fastBool False -- %i6(r30) @@ -386,20 +374,13 @@ freeReg regno -- regs not matched above are allocable. _ -> fastBool True - --- allocatableRegs is allMachRegNos with the fixed-use regs removed. --- i.e., these are the regs for which we are prepared to allow the --- register allocator to attempt to map VRegs to. -allocatableRegs :: [RegNo] -allocatableRegs - = let isFree i = isFastTrue (freeReg i) - in filter isFree allMachRegNos - +-} -- | Returns Just the real register that a global register is stored in. -- Returns Nothing if the global has no real register, and is stored -- in the in-memory register table instead. -- +{- globalRegMaybe :: GlobalReg -> Maybe Reg globalRegMaybe gg = case gg of @@ -423,22 +404,8 @@ globalRegMaybe gg Sp -> Just (RealReg 24) -- %i0 SpLim -> Just (RealReg 26) -- %i2 Hp -> Just (RealReg 27) -- %i3 - HpLim -> Just (RealReg 28) -- %i4 BaseReg -> Just (RealReg 25) -- %i1 _ -> Nothing - - --- We map STG registers onto appropriate CmmExprs. Either they map --- to real machine registers or stored as offsets from BaseReg. Given --- a GlobalReg, get_GlobalReg_reg_or_addr produces either the real --- register it is in, on this platform, or a CmmExpr denoting the --- address in the register table holding it. --- (See also get_GlobalReg_addr in CgUtils.) - -get_GlobalReg_reg_or_addr :: GlobalReg -> Either Reg CmmExpr -get_GlobalReg_reg_or_addr mid - = case globalRegMaybe mid of - Just rr -> Left rr - Nothing -> Right (get_GlobalReg_addr mid) +-}