X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FSPARC%2FRegs.hs;h=79119582d30fe0690e7996cb414e961b2c92090b;hb=7f860170afc072bcf64baf6aeb854acf01146c90;hp=987fc2da144a23ef0535eaa9514033d5785e9798;hpb=79607e5359a381ee5f40a5dcec313f1c94105c7b;p=ghc-hetmet.git diff --git a/compiler/nativeGen/SPARC/Regs.hs b/compiler/nativeGen/SPARC/Regs.hs index 987fc2d..7911958 100644 --- a/compiler/nativeGen/SPARC/Regs.hs +++ b/compiler/nativeGen/SPARC/Regs.hs @@ -5,294 +5,69 @@ -- ----------------------------------------------------------------------------- module SPARC.Regs ( - - -- sizes - Size(..), - intSize, - floatSize, - isFloatSize, - wordSize, - cmmTypeSize, - sizeToWidth, - mkVReg, - - -- 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, f26, f27, + fp, sp, g0, g1, g2, o0, o1, f0, f6, f8, f22, f26, f27, nCG_FirstFloatReg, + fPair, - -- horror show + -- allocatable freeReg, - globalRegMaybe + allocatableRegs, + globalRegMaybe, + get_GlobalReg_reg_or_addr, + + -- args + argRegs, + allArgRegs, + callClobberedRegs, + + -- + mkVReg, + regDotColor ) where -#include "nativeGen/NCG.h" -#include "HsVersions.h" -#include "../includes/MachRegs.h" -import RegsBase +import Reg +import RegClass +import Size -import BlockId import Cmm -import CLabel ( CLabel ) -import Pretty -import Outputable ( Outputable(..), pprPanic, panic ) -import qualified Outputable +import CgUtils ( get_GlobalReg_addr ) + import Unique -import Constants +import Outputable import FastBool --- sizes ----------------------------------------------------------------------- - --- | A 'Size' also includes format information, such as whether --- the word is signed or unsigned. --- -data Size - = II8 -- byte (signed) - | II16 -- halfword (signed, 2 bytes) - | II32 -- word (4 bytes) - | II64 -- word (8 bytes) - | FF32 -- IEEE single-precision floating pt - | FF64 -- IEEE single-precision floating pt - deriving Eq - - --- | Get the integer size of this width. -intSize :: Width -> Size -intSize width - = case width of - W8 -> II8 - W16 -> II16 - W32 -> II32 - W64 -> II64 - other -> pprPanic "SPARC.Regs.intSize" (ppr other) - - --- | Get the float size of this width. -floatSize :: Width -> Size -floatSize width - = case width of - W32 -> FF32 - W64 -> FF64 - other -> pprPanic "SPARC.Regs.intSize" (ppr other) - - --- | Check if a size represents a floating point value. -isFloatSize :: Size -> Bool -isFloatSize size - = case size of - FF32 -> True - FF64 -> True - _ -> False - - --- | Size of a machine word. --- This is big enough to hold a pointer. -wordSize :: Size -wordSize = intSize wordWidth - - --- | Convert a Cmm type to a Size. -cmmTypeSize :: CmmType -> Size -cmmTypeSize ty - | isFloatType ty = floatSize (typeWidth ty) - | otherwise = intSize (typeWidth ty) - - --- | Get the Width of a Size. -sizeToWidth :: Size -> Width -sizeToWidth size - = case size of - II8 -> W8 - II16 -> W16 - II32 -> W32 - II64 -> W64 - FF32 -> W32 - FF64 -> W64 - - --- | 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" - - --- 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!" - - --- | 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. @@ -310,53 +85,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 @@ -390,48 +127,25 @@ 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 = unRealReg NCG_FirstFloatReg -#else -nCG_FirstFloatReg :: RegNo -nCG_FirstFloatReg = unRealReg f22 -#endif - - --- horror show ----------------------------------------------------------------- -#if sparc_TARGET_ARCH -#define g0 0 -#define g1 1 -#define g2 2 -#define g3 3 -#define g4 4 -#define g5 5 -#define g6 6 -#define g7 7 -#define o0 8 -#define o1 9 -#define o2 10 -#define o3 11 -#define o4 12 -#define o5 13 -#define o6 14 -#define o7 15 -#define l0 16 -#define l1 17 -#define l2 18 -#define l3 19 -#define l4 20 -#define l5 21 -#define l6 22 -#define l7 23 -#define i0 24 -#define i1 25 -#define i2 26 -#define i3 27 -#define i4 28 -#define i5 29 -#define i6 30 -#define i7 31 +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 @@ -445,7 +159,11 @@ freeReg regno -- %g1(r1) - %g4(r4) are allocable ----------------- -freeReg :: RegNo -> FastBool + -- %g5(r5) - %g7(r7) + -- are reserved for the OS + 5 -> fastBool False + 6 -> fastBool False + 7 -> fastBool False -- %o0(r8) - %o5(r13) are allocable ---------------- @@ -507,7 +225,15 @@ freeReg :: RegNo -> FastBool -- 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. @@ -539,15 +265,77 @@ globalRegMaybe gg Hp -> Just (RealReg 27) -- %i3 HpLim -> Just (RealReg 28) -- %i4 -globalRegMaybe :: GlobalReg -> Maybe Reg + 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) -#else -freeReg _ = 0# -globalRegMaybe = panic "SPARC.Regs.globalRegMaybe: not defined" +-- | 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!" + -#endif +-- | 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"