-- -----------------------------------------------------------------------------
--
-- (c) The University of Glasgow 1994-2004
--
-- -----------------------------------------------------------------------------

module GHC.CmmToAsm.SPARC.Regs (
        -- registers
        showReg,
        virtualRegSqueeze,
        realRegSqueeze,
        classOfRealReg,
        allRealRegs,

        -- machine specific info
        gReg, iReg, lReg, oReg, fReg,
        fp, sp, g0, g1, g2, o0, o1, f0, f1, f6, f8, f22, f26, f27,

        -- allocatable
        allocatableRegs,

        -- args
        argRegs,
        allArgRegs,
        callClobberedRegs,

        --
        mkVirtualReg,
        regDotColor
)

where


import GHC.Prelude

import GHC.Platform.SPARC
import GHC.Platform.Reg
import GHC.Platform.Reg.Class
import GHC.CmmToAsm.Format

import GHC.Types.Unique
import GHC.Utils.Outputable
import GHC.Utils.Panic

{-
        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
        includes/stg/MachRegs.h for a description of what's going on
        here.
-}


-- | Get the standard name for the register with this number.
showReg :: RegNo -> String
showReg :: RegNo -> String
showReg RegNo
n
        | RegNo
n forall a. Ord a => a -> a -> Bool
>= RegNo
0  Bool -> Bool -> Bool
&& RegNo
n forall a. Ord a => a -> a -> Bool
< RegNo
8   = String
"%g" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show RegNo
n
        | RegNo
n forall a. Ord a => a -> a -> Bool
>= RegNo
8  Bool -> Bool -> Bool
&& RegNo
n forall a. Ord a => a -> a -> Bool
< RegNo
16  = String
"%o" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RegNo
nforall a. Num a => a -> a -> a
-RegNo
8)
        | RegNo
n forall a. Ord a => a -> a -> Bool
>= RegNo
16 Bool -> Bool -> Bool
&& RegNo
n forall a. Ord a => a -> a -> Bool
< RegNo
24  = String
"%l" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RegNo
nforall a. Num a => a -> a -> a
-RegNo
16)
        | RegNo
n forall a. Ord a => a -> a -> Bool
>= RegNo
24 Bool -> Bool -> Bool
&& RegNo
n forall a. Ord a => a -> a -> Bool
< RegNo
32  = String
"%i" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RegNo
nforall a. Num a => a -> a -> a
-RegNo
24)
        | RegNo
n forall a. Ord a => a -> a -> Bool
>= RegNo
32 Bool -> Bool -> Bool
&& RegNo
n forall a. Ord a => a -> a -> Bool
< RegNo
64  = String
"%f" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RegNo
nforall a. Num a => a -> a -> a
-RegNo
32)
        | Bool
otherwise          = forall a. String -> a
panic String
"SPARC.Regs.showReg: unknown sparc register"


-- Get the register class of a certain real reg
classOfRealReg :: RealReg -> RegClass
classOfRealReg :: RealReg -> RegClass
classOfRealReg RealReg
reg
 = case RealReg
reg of
        RealRegSingle RegNo
i
                | RegNo
i forall a. Ord a => a -> a -> Bool
< RegNo
32        -> RegClass
RcInteger
                | Bool
otherwise     -> RegClass
RcFloat

        RealRegPair{}           -> RegClass
RcDouble


-- | regSqueeze_class reg
--      Calculate 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 -> Int

virtualRegSqueeze :: RegClass -> VirtualReg -> RegNo
virtualRegSqueeze RegClass
cls VirtualReg
vr
 = case RegClass
cls of
        RegClass
RcInteger
         -> case VirtualReg
vr of
                VirtualRegI{}           -> RegNo
1
                VirtualRegHi{}          -> RegNo
1
                VirtualReg
_other                  -> RegNo
0

        RegClass
RcFloat
         -> case VirtualReg
vr of
                VirtualRegF{}           -> RegNo
1
                VirtualRegD{}           -> RegNo
2
                VirtualReg
_other                  -> RegNo
0

        RegClass
RcDouble
         -> case VirtualReg
vr of
                VirtualRegF{}           -> RegNo
1
                VirtualRegD{}           -> RegNo
1
                VirtualReg
_other                  -> RegNo
0


{-# INLINE realRegSqueeze #-}
realRegSqueeze :: RegClass -> RealReg -> Int

realRegSqueeze :: RegClass -> RealReg -> RegNo
realRegSqueeze RegClass
cls RealReg
rr
 = case RegClass
cls of
        RegClass
RcInteger
         -> case RealReg
rr of
                RealRegSingle RegNo
regNo
                        | RegNo
regNo forall a. Ord a => a -> a -> Bool
< RegNo
32    -> RegNo
1
                        | Bool
otherwise     -> RegNo
0

                RealRegPair{}           -> RegNo
0

        RegClass
RcFloat
         -> case RealReg
rr of
                RealRegSingle RegNo
regNo
                        | RegNo
regNo forall a. Ord a => a -> a -> Bool
< RegNo
32    -> RegNo
0
                        | Bool
otherwise     -> RegNo
1

                RealRegPair{}           -> RegNo
2

        RegClass
RcDouble
         -> case RealReg
rr of
                RealRegSingle RegNo
regNo
                        | RegNo
regNo forall a. Ord a => a -> a -> Bool
< RegNo
32    -> RegNo
0
                        | Bool
otherwise     -> RegNo
1

                RealRegPair{}           -> RegNo
1


-- | All the allocatable registers in the machine,
--      including register pairs.
allRealRegs :: [RealReg]
allRealRegs :: [RealReg]
allRealRegs
        =  [ (RegNo -> RealReg
RealRegSingle RegNo
i)          | RegNo
i <- [RegNo
0..RegNo
63] ]
        forall a. [a] -> [a] -> [a]
++ [ (RegNo -> RegNo -> RealReg
RealRegPair   RegNo
i (RegNo
iforall a. Num a => a -> a -> a
+RegNo
1))    | RegNo
i <- [RegNo
32, RegNo
34 .. RegNo
62 ] ]


-- | Get the regno for this sort of reg
gReg, lReg, iReg, oReg, fReg :: Int -> RegNo

gReg :: RegNo -> RegNo
gReg RegNo
x  = RegNo
x             -- global regs
oReg :: RegNo -> RegNo
oReg RegNo
x  = (RegNo
8 forall a. Num a => a -> a -> a
+ RegNo
x)       -- output regs
lReg :: RegNo -> RegNo
lReg RegNo
x  = (RegNo
16 forall a. Num a => a -> a -> a
+ RegNo
x)      -- local regs
iReg :: RegNo -> RegNo
iReg RegNo
x  = (RegNo
24 forall a. Num a => a -> a -> a
+ RegNo
x)      -- input regs
fReg :: RegNo -> RegNo
fReg RegNo
x  = (RegNo
32 forall a. Num a => a -> a -> a
+ RegNo
x)      -- float regs


-- | Some specific regs used by the code generator.
g0, g1, g2, fp, sp, o0, o1, f0, f1, f6, f8, f22, f26, f27 :: Reg

f6 :: Reg
f6  = RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle (RegNo -> RegNo
fReg RegNo
6))
f8 :: Reg
f8  = RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle (RegNo -> RegNo
fReg RegNo
8))
f22 :: Reg
f22 = RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle (RegNo -> RegNo
fReg RegNo
22))
f26 :: Reg
f26 = RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle (RegNo -> RegNo
fReg RegNo
26))
f27 :: Reg
f27 = RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle (RegNo -> RegNo
fReg RegNo
27))

-- g0 is always zero, and writes to it vanish.
g0 :: Reg
g0  = RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle (RegNo -> RegNo
gReg RegNo
0))
g1 :: Reg
g1  = RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle (RegNo -> RegNo
gReg RegNo
1))
g2 :: Reg
g2  = RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle (RegNo -> RegNo
gReg RegNo
2))

-- FP, SP, int and float return (from C) regs.
fp :: Reg
fp  = RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle (RegNo -> RegNo
iReg RegNo
6))
sp :: Reg
sp  = RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle (RegNo -> RegNo
oReg RegNo
6))
o0 :: Reg
o0  = RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle (RegNo -> RegNo
oReg RegNo
0))
o1 :: Reg
o1  = RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle (RegNo -> RegNo
oReg RegNo
1))
f0 :: Reg
f0  = RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle (RegNo -> RegNo
fReg RegNo
0))
f1 :: Reg
f1  = RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle (RegNo -> RegNo
fReg RegNo
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))

fPair (VirtualRegD u)
        = Just (VirtualRegHi u)

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 fixed use regs removed.
--
allocatableRegs :: [RealReg]
allocatableRegs :: [RealReg]
allocatableRegs
   = let isFree :: RealReg -> Bool
isFree RealReg
rr
           = case RealReg
rr of
                RealRegSingle RegNo
r     -> RegNo -> Bool
freeReg RegNo
r
                RealRegPair   RegNo
r1 RegNo
r2 -> RegNo -> Bool
freeReg RegNo
r1 Bool -> Bool -> Bool
&& RegNo -> Bool
freeReg RegNo
r2
     in forall a. (a -> Bool) -> [a] -> [a]
filter RealReg -> Bool
isFree [RealReg]
allRealRegs


-- | The registers to place arguments for function calls,
--      for some number of arguments.
--
argRegs :: RegNo -> [Reg]
argRegs :: RegNo -> [Reg]
argRegs RegNo
r
 = case RegNo
r of
        RegNo
0       -> []
        RegNo
1       -> forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RealReg
RealRegSingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
oReg) [RegNo
0]
        RegNo
2       -> forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RealReg
RealRegSingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
oReg) [RegNo
0,RegNo
1]
        RegNo
3       -> forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RealReg
RealRegSingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
oReg) [RegNo
0,RegNo
1,RegNo
2]
        RegNo
4       -> forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RealReg
RealRegSingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
oReg) [RegNo
0,RegNo
1,RegNo
2,RegNo
3]
        RegNo
5       -> forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RealReg
RealRegSingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
oReg) [RegNo
0,RegNo
1,RegNo
2,RegNo
3,RegNo
4]
        RegNo
6       -> forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RealReg
RealRegSingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
oReg) [RegNo
0,RegNo
1,RegNo
2,RegNo
3,RegNo
4,RegNo
5]
        RegNo
_       -> forall a. String -> a
panic String
"MachRegs.argRegs(sparc): don't know about >6 arguments!"


-- | All the regs that could possibly be returned by argRegs
--
allArgRegs :: [Reg]
allArgRegs :: [Reg]
allArgRegs
        = forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RealReg
RealRegSingle) [RegNo -> RegNo
oReg RegNo
i | RegNo
i <- [RegNo
0..RegNo
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 :: [Reg]
callClobberedRegs
        = forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RealReg
RealRegSingle)
                (  RegNo -> RegNo
oReg RegNo
7 forall a. a -> [a] -> [a]
:
                  [RegNo -> RegNo
oReg RegNo
i | RegNo
i <- [RegNo
0..RegNo
5]] forall a. [a] -> [a] -> [a]
++
                  [RegNo -> RegNo
gReg RegNo
i | RegNo
i <- [RegNo
1..RegNo
7]] forall a. [a] -> [a] -> [a]
++
                  [RegNo -> RegNo
fReg RegNo
i | RegNo
i <- [RegNo
0..RegNo
31]] )



-- | Make a virtual reg with this format.
mkVirtualReg :: Unique -> Format -> VirtualReg
mkVirtualReg :: Unique -> Format -> VirtualReg
mkVirtualReg Unique
u Format
format
        | Bool -> Bool
not (Format -> Bool
isFloatFormat Format
format)
        = Unique -> VirtualReg
VirtualRegI Unique
u

        | Bool
otherwise
        = case Format
format of
                Format
FF32    -> Unique -> VirtualReg
VirtualRegF Unique
u
                Format
FF64    -> Unique -> VirtualReg
VirtualRegD Unique
u
                Format
_       -> forall a. String -> a
panic String
"mkVReg"


regDotColor :: RealReg -> SDoc
regDotColor :: RealReg -> SDoc
regDotColor RealReg
reg
 = case RealReg -> RegClass
classOfRealReg RealReg
reg of
        RegClass
RcInteger       -> String -> SDoc
text String
"blue"
        RegClass
RcFloat         -> String -> SDoc
text String
"red"
        RegClass
_other          -> String -> SDoc
text String
"green"