+++ /dev/null
-
------------------------------------------------------------------------------
---
--- 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
-- -----------------------------------------------------------------------------
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
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.
| 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
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
= 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"
projects / ghc-hetmet.git / commitdiff