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

where

import GhcPrelude

import SPARC.Instr
import SPARC.Imm
import SPARC.AddrMode
import SPARC.Regs
import SPARC.Ppr        ()
import Instruction
import Reg
import Format
import Cmm


import Outputable
import OrdList

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

expandTop (CmmProc info :: LabelMap CmmStatics
info lbl :: CLabel
lbl live :: [GlobalReg]
live (ListGraph blocks :: [GenBasicBlock Instr]
blocks))
        = LabelMap CmmStatics
-> CLabel
-> [GlobalReg]
-> ListGraph Instr
-> NatCmmDecl CmmStatics Instr
forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc LabelMap CmmStatics
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 label :: BlockId
label instrs :: [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 (ii :: Instr
ii:is :: [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 refered 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
instr
 = let  patchF :: Reg -> Reg
patchF reg :: Reg
reg
         = case Reg
reg of
                RegReal (RealRegSingle _)
                        -> Reg
reg

                RegReal (RealRegPair r1 :: RegNo
r1 r2 :: RegNo
r2)

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

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

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

   in   Instr -> (Reg -> Reg) -> Instr
forall instr. Instruction instr => 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
instr

        -- Translate to:
        --    add g1,g2,g1
        --    ld  [g1],%fn
        --    ld  [g1+4],%f(n+1)
        --    sub g1,g2,g1           -- to restore g1
        | LD FF64 (AddrRegReg r1 :: Reg
r1 r2 :: Reg
r2) fReg :: 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 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 FF64 addr :: AddrMode
addr fReg :: Reg
fReg                     <- Instr
instr
        = let   Just addr' :: AddrMode
addr'      = AddrMode -> RegNo -> Maybe AddrMode
addrOffset AddrMode
addr 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 FF64 fReg :: Reg
fReg (AddrRegReg r1 :: Reg
r1 r2 :: 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 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 FF64 fReg :: Reg
fReg addr :: AddrMode
addr                     <- Instr
instr
        = let   Just addr' :: AddrMode
addr'      = AddrMode -> RegNo -> Maybe AddrMode
addrOffset AddrMode
addr 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 r1 :: RegNo
r1))
        | RegNo
r1            RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= 32
        , RegNo
r1            RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
<= 63
        , RegNo
r1 RegNo -> RegNo -> RegNo
forall a. Integral a => a -> a -> a
`mod` 2 RegNo -> RegNo -> Bool
forall a. Eq a => a -> a -> Bool
== 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
+ 1))

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