Split Reg into vreg/hreg and add register pairs
[ghc-hetmet.git] / compiler / nativeGen / SPARC / Regs.hs
index b129d44..1c41e88 100644 (file)
@@ -7,19 +7,17 @@
 module SPARC.Regs (
        -- registers
        showReg,
-       regClass,
-       allMachRegNos,
+       virtualRegSqueeze,
+       realRegSqueeze,
+       classOfRealReg,
+       allRealRegs,
 
        -- machine specific info
        gReg, iReg, lReg, oReg, fReg,
-       fp, sp, g0, g1, g2, o0, o1, f0, f6, f8, f22, f26, f27,
-       nCG_FirstFloatReg,
-       fPair,
+       fp, sp, g0, g1, g2, o0, o1, f0, f1, f6, f8, f22, f26, f27,
 
        -- allocatable
-       freeReg,
        allocatableRegs,
-       globalRegMaybe,
        get_GlobalReg_reg_or_addr,
 
        -- args
@@ -28,25 +26,27 @@ module SPARC.Regs (
        callClobberedRegs,
 
        -- 
-       mkVReg,
+       mkVirtualReg,
        regDotColor
 )
 
 where
 
 
+import SPARC.RegPlate
 import Reg
 import RegClass
 import Size
 
 import Cmm
+import PprCmm          ()
 import CgUtils          ( get_GlobalReg_addr )
 
 import Unique
 import Outputable
+import FastTypes
 import FastBool
 
-
 {-
        The SPARC has 64 registers of interest; 32 integer registers and 32
        floating point registers.  The mapping of STG registers to SPARC
@@ -70,30 +70,84 @@ showReg n
        | otherwise          = panic "SPARC.Regs.showReg: unknown sparc register"
 
 
--- | Get the class of a register.
-{-# INLINE regClass      #-}
-regClass :: Reg -> RegClass
-regClass reg
+-- Get the register class of a certain real reg
+classOfRealReg :: RealReg -> RegClass
+classOfRealReg reg
  = case reg of
-       VirtualRegI  _  -> RcInteger
-       VirtualRegHi _  -> RcInteger
-       VirtualRegF  _  -> RcFloat
-       VirtualRegD  _  -> RcDouble
-       RealReg i
-         | i < 32                      -> RcInteger 
-         | i < nCG_FirstFloatReg       -> RcDouble
-         | otherwise                   -> RcFloat
-
-
--- | 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.
+       RealRegSingle i
+               | i < 32        -> RcInteger
+               | otherwise     -> RcFloat
+               
+       RealRegPair{}           -> RcDouble
+
+
+-- | 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.
 --
-allMachRegNos :: [RegNo]
-allMachRegNos  
-       = ([0..31]
-               ++ [32,34 .. nCG_FirstFloatReg-1]
-               ++ [nCG_FirstFloatReg .. 63])   
+{-# 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 ] ]
 
 
 -- | Get the regno for this sort of reg
@@ -107,34 +161,29 @@ 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
+g0, g1, g2, fp, sp, o0, o1, f0, f1, 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)
+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  = RealReg (gReg 0) -- g0 is always zero, and writes to it vanish.
-g1  = RealReg (gReg 1)
-g2  = RealReg (gReg 2)
+-- g0 is always zero, and writes to it vanish.
+g0  = RegReal (RealRegSingle (gReg 0))
+g1  = RegReal (RealRegSingle (gReg 1))
+g2  = RegReal (RealRegSingle (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
-
+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))
@@ -142,15 +191,112 @@ fPair (RealReg n)
 fPair (VirtualRegD u)
        = Just (VirtualRegHi u)
 
-fPair _
-       = trace ("MachInstrs.fPair: can't get high half of supposed double reg ") 
+fPair reg
+       = trace ("MachInstrs.fPair: can't get high half of supposed double reg " ++ showPpr reg)
                Nothing
+-}
+
+
+-- | 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)
+
+               RealRegPair   r1 r2     
+                       -> isFastTrue (freeReg r1) 
+                       && isFastTrue (freeReg r2)
+
+     in        filter isFree allRealRegs
+
+
+
+-- 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 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, 
+--     for some number of arguments.
+--
+argRegs :: RegNo -> [Reg]
+argRegs r
+ = case r of
+       0       -> []
+       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!"
+
+
+-- | All all the regs that could possibly be returned by argRegs
+--
+allArgRegs :: [Reg]
+allArgRegs 
+       = map (RegReal . RealRegSingle) [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 (RegReal . RealRegSingle)
+               (  oReg 7 :
+                 [oReg i | i <- [0..5]] ++
+                 [gReg i | i <- [1..7]] ++
+                 [fReg i | i <- [0..31]] )
+
+
+
+-- | Make a virtual reg with this size.
+mkVirtualReg :: Unique -> Size -> VirtualReg
+mkVirtualReg u size
+       | not (isFloatSize size) 
+       = VirtualRegI u
+
+       | otherwise
+       = case size of
+               FF32    -> VirtualRegF u
+               FF64    -> VirtualRegD u
+               _       -> panic "mkVReg"
+
+
+regDotColor :: RealReg -> SDoc
+regDotColor reg
+ = case classOfRealReg reg of
+       RcInteger       -> text "blue"
+       RcFloat         -> text "red"
+       RcDouble        -> text "green"
+
+
+
+
+-- 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
@@ -228,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
@@ -269,74 +408,4 @@ globalRegMaybe gg
        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)
-
-
--- | 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"
+-}