    {-# LANGUAGE CPP #-}

    -- | Free regs map for SPARC
    module GHC.CmmToAsm.Reg.Linear.SPARC where

    import GHC.Prelude

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

    import GHC.Platform.Regs
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Platform

    import Data.Word

    --------------------------------------------------------------------------------
    -- SPARC is like PPC, except for twinning of floating point regs.
    --      When we allocate a double reg we must take an even numbered
    --      float reg, as well as the one after it.

    -- Holds bitmaps showing what registers are currently allocated.
    --      The float and double reg bitmaps overlap, but we only alloc
    --      float regs into the float map, and double regs into the double map.
    --
    --      Free regs have a bit set in the corresponding bitmap.
    --
    data FreeRegs
            = FreeRegs
                    !Word32         -- int    reg bitmap    regs  0..31
                    !Word32         -- float  reg bitmap    regs 32..63
                    !Word32         -- double reg bitmap    regs 32..63

    instance Show FreeRegs where
            show :: FreeRegs -> String
    show = FreeRegs -> String
    showFreeRegs

    instance Outputable FreeRegs where
            ppr :: FreeRegs -> SDoc
    ppr = String -> SDoc
    text forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FreeRegs -> String
    showFreeRegs

    -- | A reg map where no regs are free to be allocated.
    noFreeRegs :: FreeRegs
    noFreeRegs :: FreeRegs
    noFreeRegs = Word32 -> Word32 -> Word32 -> FreeRegs
    FreeRegs Word32
    0 Word32
    0 Word32
    0

    -- | The initial set of free regs.
    initFreeRegs :: Platform -> FreeRegs
    initFreeRegs :: Platform -> FreeRegs
    initFreeRegs Platform
    platform
     =      forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
    flip forall a b. (a -> b) -> a -> b
    $ Platform -> RealReg -> FreeRegs -> FreeRegs
    releaseReg Platform
    platform) FreeRegs
    noFreeRegs [RealReg]
    allocatableRegs

    -- | Get all the free registers of this class.
    getFreeRegs :: RegClass -> FreeRegs -> [RealReg]        -- lazily
    getFreeRegs :: RegClass -> FreeRegs -> [RealReg]
    getFreeRegs RegClass
    cls (FreeRegs Word32
    g Word32
    f Word32
    d)
            | RegClass
    RcInteger <- RegClass
    cls = forall a b. (a -> b) -> [a] -> [b]
    map RegNo -> RealReg
    RealRegSingle                  forall a b. (a -> b) -> a -> b
    $ forall {t}. (Num t, Bits t) => RegNo -> t -> t -> RegNo -> [RegNo]
    go RegNo
    1 Word32
    g Word32
    1 RegNo
    0
            | RegClass
    RcFloat   <- RegClass
    cls = forall a b. (a -> b) -> [a] -> [b]
    map RegNo -> RealReg
    RealRegSingle                  forall a b. (a -> b) -> a -> b
    $ forall {t}. (Num t, Bits t) => RegNo -> t -> t -> RegNo -> [RegNo]
    go RegNo
    1 Word32
    f Word32
    1 RegNo
    32
            | RegClass
    RcDouble  <- RegClass
    cls = forall a b. (a -> b) -> [a] -> [b]
    map (\RegNo
    i -> RegNo -> RegNo -> RealReg
    RealRegPair RegNo
    i (RegNo
    iforall a. Num a => a -> a -> a
    +RegNo
    1))    forall a b. (a -> b) -> a -> b
    $ forall {t}. (Num t, Bits t) => RegNo -> t -> t -> RegNo -> [RegNo]
    go RegNo
    2 Word32
    d Word32
    1 RegNo
    32
    #if __GLASGOW_HASKELL__ <= 810
            | otherwise = pprPanic "RegAllocLinear.getFreeRegs: Bad register class " (ppr cls)
    #endif
            where
                    go :: RegNo -> t -> t -> RegNo -> [RegNo]
    go RegNo
    _    t
    _      t
    0    RegNo
    _
                            = []

                    go RegNo
    step t
    bitmap t
    mask RegNo
    ix
                            | t
    bitmap forall a. Bits a => a -> a -> a
    .&. t
    mask forall a. Eq a => a -> a -> Bool
    /= t
    0
                            = RegNo
    ix forall a. a -> [a] -> [a]
    : (RegNo -> t -> t -> RegNo -> [RegNo]
    go RegNo
    step t
    bitmap (t
    mask forall a. Bits a => a -> RegNo -> a
    `shiftL` RegNo
    step) forall a b. (a -> b) -> a -> b
    $! RegNo
    ix forall a. Num a => a -> a -> a
    + RegNo
    step)

                            | Bool
    otherwise
                            = RegNo -> t -> t -> RegNo -> [RegNo]
    go RegNo
    step t
    bitmap (t
    mask forall a. Bits a => a -> RegNo -> a
    `shiftL` RegNo
    step) forall a b. (a -> b) -> a -> b
    $! RegNo
    ix forall a. Num a => a -> a -> a
    + RegNo
    step

    -- | Grab a register.
    allocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
    allocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
    allocateReg Platform
    platform
             reg :: RealReg
    reg@(RealRegSingle RegNo
    r)
                 (FreeRegs Word32
    g Word32
    f Word32
    d)

            -- can't allocate free regs
            | Bool -> Bool
    not forall a b. (a -> b) -> a -> b
    $ Platform -> RegNo -> Bool
    freeReg Platform
    platform RegNo
    r
            = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "SPARC.FreeRegs.allocateReg: not allocating pinned reg" (forall a. Outputable a => a -> SDoc
    ppr RealReg
    reg)

            -- a general purpose reg
            | RegNo
    r forall a. Ord a => a -> a -> Bool
    <= RegNo
    31
            = let   mask :: Word32
    mask    = forall a. Bits a => a -> a
    complement (RegNo -> Word32
    bitMask RegNo
    r)
              in    Word32 -> Word32 -> Word32 -> FreeRegs
    FreeRegs
                            (Word32
    g forall a. Bits a => a -> a -> a
    .&. Word32
    mask)
                            Word32
    f
                            Word32
    d

            -- a float reg
            | RegNo
    r forall a. Ord a => a -> a -> Bool
    >= RegNo
    32, RegNo
    r forall a. Ord a => a -> a -> Bool
    <= RegNo
    63
            = let   mask :: Word32
    mask    = forall a. Bits a => a -> a
    complement (RegNo -> Word32
    bitMask (RegNo
    r forall a. Num a => a -> a -> a
    - RegNo
    32))

                    -- the mask of the double this FP reg aliases
                    maskLow :: Word32
    maskLow = if RegNo
    r forall a. Integral a => a -> a -> a
    `mod` RegNo
    2 forall a. Eq a => a -> a -> Bool
    == RegNo
    0
                                    then forall a. Bits a => a -> a
    complement (RegNo -> Word32
    bitMask (RegNo
    r forall a. Num a => a -> a -> a
    - RegNo
    32))
                                    else forall a. Bits a => a -> a
    complement (RegNo -> Word32
    bitMask (RegNo
    r forall a. Num a => a -> a -> a
    - RegNo
    32 forall a. Num a => a -> a -> a
    - RegNo
    1))
              in    Word32 -> Word32 -> Word32 -> FreeRegs
    FreeRegs
                            Word32
    g
                            (Word32
    f forall a. Bits a => a -> a -> a
    .&. Word32
    mask)
                            (Word32
    d forall a. Bits a => a -> a -> a
    .&. Word32
    maskLow)

            | Bool
    otherwise
            = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "SPARC.FreeRegs.releaseReg: not allocating bad reg" (forall a. Outputable a => a -> SDoc
    ppr RealReg
    reg)

    allocateReg Platform
    _
             reg :: RealReg
    reg@(RealRegPair RegNo
    r1 RegNo
    r2)
                 (FreeRegs Word32
    g Word32
    f Word32
    d)

            | RegNo
    r1 forall a. Ord a => a -> a -> Bool
    >= RegNo
    32, RegNo
    r1 forall a. Ord a => a -> a -> Bool
    <= RegNo
    63, RegNo
    r1 forall a. Integral a => a -> a -> a
    `mod` RegNo
    2 forall a. Eq a => a -> a -> Bool
    == RegNo
    0
            , RegNo
    r2 forall a. Ord a => a -> a -> Bool
    >= RegNo
    32, RegNo
    r2 forall a. Ord a => a -> a -> Bool
    <= RegNo
    63
            = let   mask1 :: Word32
    mask1   = forall a. Bits a => a -> a
    complement (RegNo -> Word32
    bitMask (RegNo
    r1 forall a. Num a => a -> a -> a
    - RegNo
    32))
                    mask2 :: Word32
    mask2   = forall a. Bits a => a -> a
    complement (RegNo -> Word32
    bitMask (RegNo
    r2 forall a. Num a => a -> a -> a
    - RegNo
    32))
              in
                    Word32 -> Word32 -> Word32 -> FreeRegs
    FreeRegs
                            Word32
    g
                            ((Word32
    f forall a. Bits a => a -> a -> a
    .&. Word32
    mask1) forall a. Bits a => a -> a -> a
    .&. Word32
    mask2)
                            (Word32
    d forall a. Bits a => a -> a -> a
    .&. Word32
    mask1)

            | Bool
    otherwise
            = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "SPARC.FreeRegs.releaseReg: not allocating bad reg" (forall a. Outputable a => a -> SDoc
    ppr RealReg
    reg)

    -- | Release a register from allocation.
    --      The register liveness information says that most regs die after a C call,
    --      but we still don't want to allocate to some of them.
    --
    releaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
    releaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
    releaseReg Platform
    platform
             reg :: RealReg
    reg@(RealRegSingle RegNo
    r)
            regs :: FreeRegs
    regs@(FreeRegs Word32
    g Word32
    f Word32
    d)

            -- don't release pinned reg
            | Bool -> Bool
    not forall a b. (a -> b) -> a -> b
    $ Platform -> RegNo -> Bool
    freeReg Platform
    platform RegNo
    r
            = FreeRegs
    regs

            -- a general purpose reg
            | RegNo
    r forall a. Ord a => a -> a -> Bool
    <= RegNo
    31
            = let   mask :: Word32
    mask    = RegNo -> Word32
    bitMask RegNo
    r
              in    Word32 -> Word32 -> Word32 -> FreeRegs
    FreeRegs (Word32
    g forall a. Bits a => a -> a -> a
    .|. Word32
    mask) Word32
    f Word32
    d

            -- a float reg
            | RegNo
    r forall a. Ord a => a -> a -> Bool
    >= RegNo
    32, RegNo
    r forall a. Ord a => a -> a -> Bool
    <= RegNo
    63
            = let   mask :: Word32
    mask    = RegNo -> Word32
    bitMask (RegNo
    r forall a. Num a => a -> a -> a
    - RegNo
    32)

                    -- the mask of the double this FP reg aliases
                    maskLow :: Word32
    maskLow = if RegNo
    r forall a. Integral a => a -> a -> a
    `mod` RegNo
    2 forall a. Eq a => a -> a -> Bool
    == RegNo
    0
                                    then RegNo -> Word32
    bitMask (RegNo
    r forall a. Num a => a -> a -> a
    - RegNo
    32)
                                    else RegNo -> Word32
    bitMask (RegNo
    r forall a. Num a => a -> a -> a
    - RegNo
    32 forall a. Num a => a -> a -> a
    - RegNo
    1)
              in    Word32 -> Word32 -> Word32 -> FreeRegs
    FreeRegs
                            Word32
    g
                            (Word32
    f forall a. Bits a => a -> a -> a
    .|. Word32
    mask)
                            (Word32
    d forall a. Bits a => a -> a -> a
    .|. Word32
    maskLow)

            | Bool
    otherwise
            = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "SPARC.FreeRegs.releaseReg: not releasing bad reg" (forall a. Outputable a => a -> SDoc
    ppr RealReg
    reg)

    releaseReg Platform
    _
             reg :: RealReg
    reg@(RealRegPair RegNo
    r1 RegNo
    r2)
                 (FreeRegs Word32
    g Word32
    f Word32
    d)

            | RegNo
    r1 forall a. Ord a => a -> a -> Bool
    >= RegNo
    32, RegNo
    r1 forall a. Ord a => a -> a -> Bool
    <= RegNo
    63, RegNo
    r1 forall a. Integral a => a -> a -> a
    `mod` RegNo
    2 forall a. Eq a => a -> a -> Bool
    == RegNo
    0
            , RegNo
    r2 forall a. Ord a => a -> a -> Bool
    >= RegNo
    32, RegNo
    r2 forall a. Ord a => a -> a -> Bool
    <= RegNo
    63
            = let   mask1 :: Word32
    mask1   = RegNo -> Word32
    bitMask (RegNo
    r1 forall a. Num a => a -> a -> a
    - RegNo
    32)
                    mask2 :: Word32
    mask2   = RegNo -> Word32
    bitMask (RegNo
    r2 forall a. Num a => a -> a -> a
    - RegNo
    32)
              in
                    Word32 -> Word32 -> Word32 -> FreeRegs
    FreeRegs
                            Word32
    g
                            ((Word32
    f forall a. Bits a => a -> a -> a
    .|. Word32
    mask1) forall a. Bits a => a -> a -> a
    .|. Word32
    mask2)
                            (Word32
    d forall a. Bits a => a -> a -> a
    .|. Word32
    mask1)

            | Bool
    otherwise
            = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "SPARC.FreeRegs.releaseReg: not releasing bad reg" (forall a. Outputable a => a -> SDoc
    ppr RealReg
    reg)

    bitMask :: Int -> Word32
    bitMask :: RegNo -> Word32
    bitMask RegNo
    n       = Word32
    1 forall a. Bits a => a -> RegNo -> a
    `shiftL` RegNo
    n

    showFreeRegs :: FreeRegs -> String
    showFreeRegs :: FreeRegs -> String
    showFreeRegs FreeRegs
    regs
            =  String
    "FreeRegs\n"
            forall a. [a] -> [a] -> [a]
    ++ String
    "    integer: " forall a. [a] -> [a] -> [a]
    ++ (forall a. Show a => a -> String
    show forall a b. (a -> b) -> a -> b
    $ RegClass -> FreeRegs -> [RealReg]
    getFreeRegs RegClass
    RcInteger FreeRegs
    regs)       forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
            forall a. [a] -> [a] -> [a]
    ++ String
    "      float: " forall a. [a] -> [a] -> [a]
    ++ (forall a. Show a => a -> String
    show forall a b. (a -> b) -> a -> b
    $ RegClass -> FreeRegs -> [RealReg]
    getFreeRegs RegClass
    RcFloat   FreeRegs
    regs)       forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
            forall a. [a] -> [a] -> [a]
    ++ String
    "     double: " forall a. [a] -> [a] -> [a]
    ++ (forall a. Show a => a -> String
    show forall a b. (a -> b) -> a -> b
    $ RegClass -> FreeRegs -> [RealReg]
    getFreeRegs RegClass
    RcDouble  FreeRegs
    regs)       forall a. [a] -> [a] -> [a]
    ++ String
    "\n"