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

module 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 GhcPrelude

import CodeGen.Platform.SPARC
import Reg
import RegClass
import Format

import Unique
import 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 :: RegNo -> String
showReg n :: RegNo
n
        | RegNo
n RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= 0  Bool -> Bool -> Bool
&& RegNo
n RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< 8   = "%g" String -> String -> String
forall a. [a] -> [a] -> [a]
++ RegNo -> String
forall a. Show a => a -> String
show RegNo
n
        | RegNo
n RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= 8  Bool -> Bool -> Bool
&& RegNo
n RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< 16  = "%o" String -> String -> String
forall a. [a] -> [a] -> [a]
++ RegNo -> String
forall a. Show a => a -> String
show (RegNo
nRegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
-8)
        | RegNo
n RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= 16 Bool -> Bool -> Bool
&& RegNo
n RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< 24  = "%l" String -> String -> String
forall a. [a] -> [a] -> [a]
++ RegNo -> String
forall a. Show a => a -> String
show (RegNo
nRegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
-16)
        | RegNo
n RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= 24 Bool -> Bool -> Bool
&& RegNo
n RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< 32  = "%i" String -> String -> String
forall a. [a] -> [a] -> [a]
++ RegNo -> String
forall a. Show a => a -> String
show (RegNo
nRegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
-24)
        | RegNo
n RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= 32 Bool -> Bool -> Bool
&& RegNo
n RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< 64  = "%f" String -> String -> String
forall a. [a] -> [a] -> [a]
++ RegNo -> String
forall a. Show a => a -> String
show (RegNo
nRegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
-32)
        | Bool
otherwise          = String -> String
forall a. String -> a
panic "SPARC.Regs.showReg: unknown sparc register"


-- Get the register class of a certain real reg
classOfRealReg :: RealReg -> RegClass
classOfRealReg :: RealReg -> RegClass
classOfRealReg reg :: RealReg
reg
 = case RealReg
reg of
        RealRegSingle i :: RegNo
i
                | RegNo
i RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< 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 cls :: RegClass
cls vr :: VirtualReg
vr
 = case RegClass
cls of
        RcInteger
         -> case VirtualReg
vr of
                VirtualRegI{}           -> 1
                VirtualRegHi{}          -> 1
                _other :: VirtualReg
_other                  -> 0

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

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

        _other :: RegClass
_other -> 0

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

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

                RealRegPair{}           -> 0

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

                RealRegPair{}           -> 2

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

                RealRegPair{}           -> 1

        _other :: RegClass
_other -> 0

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


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

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

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

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

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 rr :: RealReg
rr
           = case RealReg
rr of
                RealRegSingle r :: RegNo
r     -> RegNo -> Bool
freeReg RegNo
r
                RealRegPair   r1 :: RegNo
r1 r2 :: RegNo
r2 -> RegNo -> Bool
freeReg RegNo
r1 Bool -> Bool -> Bool
&& RegNo -> Bool
freeReg RegNo
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 :: RegNo -> [Reg]
argRegs r :: RegNo
r
 = case RegNo
r of
        0       -> []
        1       -> (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal (RealReg -> Reg) -> (RegNo -> RealReg) -> RegNo -> Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RealReg
RealRegSingle (RegNo -> RealReg) -> (RegNo -> RegNo) -> RegNo -> RealReg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
oReg) [0]
        2       -> (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal (RealReg -> Reg) -> (RegNo -> RealReg) -> RegNo -> Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RealReg
RealRegSingle (RegNo -> RealReg) -> (RegNo -> RegNo) -> RegNo -> RealReg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
oReg) [0,1]
        3       -> (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal (RealReg -> Reg) -> (RegNo -> RealReg) -> RegNo -> Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RealReg
RealRegSingle (RegNo -> RealReg) -> (RegNo -> RegNo) -> RegNo -> RealReg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
oReg) [0,1,2]
        4       -> (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal (RealReg -> Reg) -> (RegNo -> RealReg) -> RegNo -> Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RealReg
RealRegSingle (RegNo -> RealReg) -> (RegNo -> RegNo) -> RegNo -> RealReg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
oReg) [0,1,2,3]
        5       -> (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal (RealReg -> Reg) -> (RegNo -> RealReg) -> RegNo -> Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RealReg
RealRegSingle (RegNo -> RealReg) -> (RegNo -> RegNo) -> RegNo -> RealReg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
oReg) [0,1,2,3,4]
        6       -> (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map (RealReg -> Reg
RegReal (RealReg -> Reg) -> (RegNo -> RealReg) -> RegNo -> Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RealReg
RealRegSingle (RegNo -> RealReg) -> (RegNo -> RegNo) -> RegNo -> RealReg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
oReg) [0,1,2,3,4,5]
        _       -> String -> [Reg]
forall a. String -> a
panic "MachRegs.argRegs(sparc): don't know about >6 arguments!"


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



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

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


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