    {-# 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))
            = forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc LabelMap RawCmmStatics
    info CLabel
    lbl [GlobalReg]
    live (forall i. [GenBasicBlock i] -> ListGraph i
    ListGraph forall a b. (a -> b) -> a -> b
    $ 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'         = forall a. OrdList a -> [a]
    fromOL OrdList Instr
    instrs_ol
       in   forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    label [Instr]
    instrs'

    -- | Expand out some instructions
    expandBlockInstrs :: [Instr] -> OrdList Instr
    expandBlockInstrs :: [Instr] -> OrdList Instr
    expandBlockInstrs []    = 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 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         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. Eq a => a -> a -> Bool
    == RegNo
    r1 forall a. Num a => a -> a -> a
    + RegNo
    1
                            -> RealReg -> Reg
    RegReal (RegNo -> RealReg
    RealRegSingle RegNo
    r1)

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

                    RegVirtual VirtualReg
    _
                            -> forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "SPARC.CodeGen.Expand: not remapping virtual reg " (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
            =       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    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
            =       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    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
            = 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            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
            = (RealReg -> Reg
    RegReal forall a b. (a -> b) -> a -> b
    $ RegNo -> RealReg
    RealRegSingle (RegNo
    r1 forall a. Num a => a -> a -> a
    + RegNo
    1))

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