-- -----------------------------------------------------------------------------
--
-- (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

{-
        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 :: Int -> String
showReg Int
n
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0  Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8   = String
"%g" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8  Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
16  = String
"%o" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
8)
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
16 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
24  = String
"%l" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
16)
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
24 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
32  = String
"%i" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
24)
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
32 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
64  = String
"%f" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
32)
        | Bool
otherwise          = String -> String
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 Int
i
                | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
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 -> Int
virtualRegSqueeze RegClass
cls VirtualReg
vr
 = case RegClass
cls of
        RegClass
RcInteger
         -> case VirtualReg
vr of
                VirtualRegI{}           -> Int
1
                VirtualRegHi{}          -> Int
1
                VirtualReg
_other                  -> Int
0

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

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


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

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

                RealRegPair{}           -> Int
0

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

                RealRegPair{}           -> Int
2

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

                RealRegPair{}           -> Int
1


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


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

gReg :: Int -> Int
gReg Int
x  = Int
x             -- global regs
oReg :: Int -> Int
oReg Int
x  = (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)       -- output regs
lReg :: Int -> Int
lReg Int
x  = (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)      -- local regs
iReg :: Int -> Int
iReg Int
x  = (Int
24 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)      -- input regs
fReg :: Int -> Int
fReg Int
x  = (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 (Int -> RealReg
RealRegSingle (Int -> Int
fReg Int
6))
f8 :: Reg
f8  = RealReg -> Reg
RegReal (Int -> RealReg
RealRegSingle (Int -> Int
fReg Int
8))
f22 :: Reg
f22 = RealReg -> Reg
RegReal (Int -> RealReg
RealRegSingle (Int -> Int
fReg Int
22))
f26 :: Reg
f26 = RealReg -> Reg
RegReal (Int -> RealReg
RealRegSingle (Int -> Int
fReg Int
26))
f27 :: Reg
f27 = RealReg -> Reg
RegReal (Int -> RealReg
RealRegSingle (Int -> Int
fReg Int
27))

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

-- FP, SP, int and float return (from C) regs.
fp :: Reg
fp  = RealReg -> Reg
RegReal (Int -> RealReg
RealRegSingle (Int -> Int
iReg Int
6))
sp :: Reg
sp  = RealReg -> Reg
RegReal (Int -> RealReg
RealRegSingle (Int -> Int
oReg Int
6))
o0 :: Reg
o0  = RealReg -> Reg
RegReal (Int -> RealReg
RealRegSingle (Int -> Int
oReg Int
0))
o1 :: Reg
o1  = RealReg -> Reg
RegReal (Int -> RealReg
RealRegSingle (Int -> Int
oReg Int
1))
f0 :: Reg
f0  = RealReg -> Reg
RegReal (Int -> RealReg
RealRegSingle (Int -> Int
fReg Int
0))
f1 :: Reg
f1  = RealReg -> Reg
RegReal (Int -> RealReg
RealRegSingle (Int -> Int
fReg Int
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 Int
r     -> Int -> Bool
freeReg Int
r
                RealRegPair   Int
r1 Int
r2 -> Int -> Bool
freeReg Int
r1 Bool -> Bool -> Bool
&& Int -> Bool
freeReg Int
r2
     in (RealReg -> Bool) -> [RealReg] -> [RealReg]
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 :: Int -> [Reg]
argRegs Int
r
 = case Int
r of
        Int
0       -> []
        Int
1       -> (Int -> Reg) -> [Int] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal (RealReg -> Reg) -> (Int -> RealReg) -> Int -> Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RealReg
RealRegSingle (Int -> RealReg) -> (Int -> Int) -> Int -> RealReg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
oReg) [Int
0]
        Int
2       -> (Int -> Reg) -> [Int] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal (RealReg -> Reg) -> (Int -> RealReg) -> Int -> Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RealReg
RealRegSingle (Int -> RealReg) -> (Int -> Int) -> Int -> RealReg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
oReg) [Int
0,Int
1]
        Int
3       -> (Int -> Reg) -> [Int] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal (RealReg -> Reg) -> (Int -> RealReg) -> Int -> Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RealReg
RealRegSingle (Int -> RealReg) -> (Int -> Int) -> Int -> RealReg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
oReg) [Int
0,Int
1,Int
2]
        Int
4       -> (Int -> Reg) -> [Int] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal (RealReg -> Reg) -> (Int -> RealReg) -> Int -> Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RealReg
RealRegSingle (Int -> RealReg) -> (Int -> Int) -> Int -> RealReg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
oReg) [Int
0,Int
1,Int
2,Int
3]
        Int
5       -> (Int -> Reg) -> [Int] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal (RealReg -> Reg) -> (Int -> RealReg) -> Int -> Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RealReg
RealRegSingle (Int -> RealReg) -> (Int -> Int) -> Int -> RealReg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
oReg) [Int
0,Int
1,Int
2,Int
3,Int
4]
        Int
6       -> (Int -> Reg) -> [Int] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal (RealReg -> Reg) -> (Int -> RealReg) -> Int -> Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RealReg
RealRegSingle (Int -> RealReg) -> (Int -> Int) -> Int -> RealReg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
oReg) [Int
0,Int
1,Int
2,Int
3,Int
4,Int
5]
        Int
_       -> String -> [Reg]
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
        = (Int -> Reg) -> [Int] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal (RealReg -> Reg) -> (Int -> RealReg) -> Int -> Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RealReg
RealRegSingle) [Int -> Int
oReg Int
i | Int
i <- [Int
0..Int
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
        = (Int -> Reg) -> [Int] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal (RealReg -> Reg) -> (Int -> RealReg) -> Int -> Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RealReg
RealRegSingle)
                (  Int -> Int
oReg Int
7 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:
                  [Int -> Int
oReg Int
i | Int
i <- [Int
0..Int
5]] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++
                  [Int -> Int
gReg Int
i | Int
i <- [Int
1..Int
7]] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++
                  [Int -> Int
fReg Int
i | Int
i <- [Int
0..Int
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
_       -> String -> VirtualReg
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"