{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

-- | Expand out synthetic instructions into single machine instrs.
module GHC.CmmToAsm.SPARC.CodeGen.Expand (
        expandTop
)

where

import GHC.Prelude

import GHC.CmmToAsm.SPARC.Instr
import GHC.CmmToAsm.SPARC.Imm
import GHC.CmmToAsm.SPARC.AddrMode
import GHC.CmmToAsm.SPARC.Regs
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Types
import GHC.Cmm

import GHC.Platform.Reg

import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Data.OrdList

-- | Expand out synthetic instructions in this top level thing
expandTop :: NatCmmDecl RawCmmStatics Instr -> NatCmmDecl RawCmmStatics Instr
expandTop :: NatCmmDecl RawCmmStatics Instr -> NatCmmDecl RawCmmStatics Instr
expandTop top :: NatCmmDecl RawCmmStatics Instr
top@(CmmData{})
        = NatCmmDecl RawCmmStatics Instr
top

expandTop (CmmProc LabelMap RawCmmStatics
info CLabel
lbl [GlobalReg]
live (ListGraph [GenBasicBlock Instr]
blocks))
        = LabelMap RawCmmStatics
-> CLabel
-> [GlobalReg]
-> ListGraph Instr
-> NatCmmDecl RawCmmStatics Instr
forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc LabelMap RawCmmStatics
info CLabel
lbl [GlobalReg]
live ([GenBasicBlock Instr] -> ListGraph Instr
forall i. [GenBasicBlock i] -> ListGraph i
ListGraph ([GenBasicBlock Instr] -> ListGraph Instr)
-> [GenBasicBlock Instr] -> ListGraph Instr
forall a b. (a -> b) -> a -> b
$ (GenBasicBlock Instr -> GenBasicBlock Instr)
-> [GenBasicBlock Instr] -> [GenBasicBlock Instr]
forall a b. (a -> b) -> [a] -> [b]
map GenBasicBlock Instr -> GenBasicBlock Instr
expandBlock [GenBasicBlock Instr]
blocks)


-- | Expand out synthetic instructions in this block
expandBlock :: NatBasicBlock Instr -> NatBasicBlock Instr

expandBlock :: GenBasicBlock Instr -> GenBasicBlock Instr
expandBlock (BasicBlock BlockId
label [Instr]
instrs)
 = let  instrs_ol :: OrdList Instr
instrs_ol       = [Instr] -> OrdList Instr
expandBlockInstrs [Instr]
instrs
        instrs' :: [Instr]
instrs'         = OrdList Instr -> [Instr]
forall a. OrdList a -> [a]
fromOL OrdList Instr
instrs_ol
   in   BlockId -> [Instr] -> GenBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
label [Instr]
instrs'


-- | Expand out some instructions
expandBlockInstrs :: [Instr] -> OrdList Instr
expandBlockInstrs :: [Instr] -> OrdList Instr
expandBlockInstrs []    = OrdList Instr
forall a. OrdList a
nilOL

expandBlockInstrs (Instr
ii:[Instr]
is)
 = let  ii_doubleRegs :: Instr
ii_doubleRegs   = Instr -> Instr
remapRegPair Instr
ii
        is_misaligned :: OrdList Instr
is_misaligned   = Instr -> OrdList Instr
expandMisalignedDoubles Instr
ii_doubleRegs

   in   OrdList Instr
is_misaligned OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
expandBlockInstrs [Instr]
is



-- | In the SPARC instruction set the FP register pairs that are used
--      to hold 64 bit floats are referred to by just the first reg
--      of the pair. Remap our internal reg pairs to the appropriate reg.
--
--      For example:
--          ldd [%l1], (%f0 | %f1)
--
--      gets mapped to
--          ldd [$l1], %f0
--
remapRegPair :: Instr -> Instr
remapRegPair :: Instr -> Instr
remapRegPair Instr
instr
 = let  patchF :: Reg -> Reg
patchF Reg
reg
         = case Reg
reg of
                RegReal (RealRegSingle RegNo
_)
                        -> Reg
reg

                RegReal (RealRegPair RegNo
r1 RegNo
r2)

                        -- sanity checking
                        | RegNo
r1         RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= RegNo
32
                        , RegNo
r1         RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
<= RegNo
63
                        , RegNo
r1 RegNo -> RegNo -> RegNo
forall a. Integral a => a -> a -> a
`mod` RegNo
2 RegNo -> RegNo -> Bool
forall a. Eq a => a -> a -> Bool
== RegNo
0
                        , RegNo
r2         RegNo -> RegNo -> Bool
forall a. Eq a => a -> a -> Bool
== RegNo
r1 RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
+ RegNo
1
                        -> RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
r1)

                        | Bool
otherwise
                        -> String -> SDoc -> Reg
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.CodeGen.Expand: not remapping dodgy looking reg pair " (Reg -> SDoc
forall a. Outputable a => a -> SDoc
ppr Reg
reg)

                RegVirtual VirtualReg
_
                        -> String -> SDoc -> Reg
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.CodeGen.Expand: not remapping virtual reg " (Reg -> SDoc
forall a. Outputable a => a -> SDoc
ppr Reg
reg)

   in   Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr Instr
instr Reg -> Reg
patchF




-- Expand out 64 bit load/stores into individual instructions to handle
--      possible double alignment problems.
--
--      TODO:   It'd be better to use a scratch reg instead of the add/sub thing.
--              We might be able to do this faster if we use the UA2007 instr set
--              instead of restricting ourselves to SPARC V9.
--
expandMisalignedDoubles :: Instr -> OrdList Instr
expandMisalignedDoubles :: Instr -> OrdList Instr
expandMisalignedDoubles Instr
instr

        -- Translate to:
        --    add g1,g2,g1
        --    ld  [g1],%fn
        --    ld  [g1+4],%f(n+1)
        --    sub g1,g2,g1           -- to restore g1
        | LD Format
FF64 (AddrRegReg Reg
r1 Reg
r2) Reg
fReg       <- Instr
instr
        =       [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL    [ Bool -> Bool -> Reg -> RI -> Reg -> Instr
ADD Bool
False Bool
False Reg
r1 (Reg -> RI
RIReg Reg
r2) Reg
r1
                        , Format -> AddrMode -> Reg -> Instr
LD  Format
FF32  (Reg -> Reg -> AddrMode
AddrRegReg Reg
r1 Reg
g0)          Reg
fReg
                        , Format -> AddrMode -> Reg -> Instr
LD  Format
FF32  (Reg -> Imm -> AddrMode
AddrRegImm Reg
r1 (RegNo -> Imm
ImmInt RegNo
4))  (Reg -> Reg
fRegHi Reg
fReg)
                        , Bool -> Bool -> Reg -> RI -> Reg -> Instr
SUB Bool
False Bool
False Reg
r1 (Reg -> RI
RIReg Reg
r2) Reg
r1 ]

        -- Translate to
        --    ld  [addr],%fn
        --    ld  [addr+4],%f(n+1)
        | LD Format
FF64 AddrMode
addr Reg
fReg                     <- Instr
instr
        = let   Just AddrMode
addr'      = AddrMode -> RegNo -> Maybe AddrMode
addrOffset AddrMode
addr RegNo
4
          in    [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL    [ Format -> AddrMode -> Reg -> Instr
LD  Format
FF32  AddrMode
addr        Reg
fReg
                        , Format -> AddrMode -> Reg -> Instr
LD  Format
FF32  AddrMode
addr'       (Reg -> Reg
fRegHi Reg
fReg) ]

        -- Translate to:
        --    add g1,g2,g1
        --    st  %fn,[g1]
        --    st  %f(n+1),[g1+4]
        --    sub g1,g2,g1           -- to restore g1
        | ST Format
FF64 Reg
fReg (AddrRegReg Reg
r1 Reg
r2)       <- Instr
instr
        =       [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL    [ Bool -> Bool -> Reg -> RI -> Reg -> Instr
ADD Bool
False Bool
False Reg
r1 (Reg -> RI
RIReg Reg
r2) Reg
r1
                        , Format -> Reg -> AddrMode -> Instr
ST  Format
FF32  Reg
fReg           (Reg -> Reg -> AddrMode
AddrRegReg Reg
r1 Reg
g0)
                        , Format -> Reg -> AddrMode -> Instr
ST  Format
FF32  (Reg -> Reg
fRegHi Reg
fReg)  (Reg -> Imm -> AddrMode
AddrRegImm Reg
r1 (RegNo -> Imm
ImmInt RegNo
4))
                        , Bool -> Bool -> Reg -> RI -> Reg -> Instr
SUB Bool
False Bool
False Reg
r1 (Reg -> RI
RIReg Reg
r2) Reg
r1 ]

        -- Translate to
        --    ld  [addr],%fn
        --    ld  [addr+4],%f(n+1)
        | ST Format
FF64 Reg
fReg AddrMode
addr                     <- Instr
instr
        = let   Just AddrMode
addr'      = AddrMode -> RegNo -> Maybe AddrMode
addrOffset AddrMode
addr RegNo
4
          in    [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL    [ Format -> Reg -> AddrMode -> Instr
ST  Format
FF32  Reg
fReg           AddrMode
addr
                        , Format -> Reg -> AddrMode -> Instr
ST  Format
FF32  (Reg -> Reg
fRegHi Reg
fReg)  AddrMode
addr'         ]

        -- some other instr
        | Bool
otherwise
        = Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL Instr
instr



-- | The high partner for this float reg.
fRegHi :: Reg -> Reg
fRegHi :: Reg -> Reg
fRegHi (RegReal (RealRegSingle RegNo
r1))
        | RegNo
r1            RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= RegNo
32
        , RegNo
r1            RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
<= RegNo
63
        , RegNo
r1 RegNo -> RegNo -> RegNo
forall a. Integral a => a -> a -> a
`mod` RegNo
2 RegNo -> RegNo -> Bool
forall a. Eq a => a -> a -> Bool
== RegNo
0
        = (RealReg -> Reg
RegReal (RealReg -> Reg) -> RealReg -> Reg
forall a b. (a -> b) -> a -> b
$ RegNo -> RealReg
RealRegSingle (RegNo
r1 RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
+ RegNo
1))

-- Can't take high partner for non-low reg.
fRegHi Reg
reg
        = String -> SDoc -> Reg
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.CodeGen.Expand: can't take fRegHi from " (Reg -> SDoc
forall a. Outputable a => a -> SDoc
ppr Reg
reg)