    -- | Evaluation of 64 bit values on 32 bit platforms.
    module GHC.CmmToAsm.SPARC.CodeGen.Gen64 (
            assignMem_I64Code,
            assignReg_I64Code,
            iselExpr64
    )

    where

    import GHC.Prelude

    import {-# SOURCE #-} GHC.CmmToAsm.SPARC.CodeGen.Gen32
    import GHC.CmmToAsm.SPARC.CodeGen.Base
    import GHC.CmmToAsm.SPARC.CodeGen.Amode
    import GHC.CmmToAsm.SPARC.Regs
    import GHC.CmmToAsm.SPARC.AddrMode
    import GHC.CmmToAsm.SPARC.Imm
    import GHC.CmmToAsm.SPARC.Instr
    import GHC.CmmToAsm.Monad
    import GHC.CmmToAsm.Format
    import GHC.Platform.Reg

    import GHC.Cmm

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

    -- | Code to assign a 64 bit value to memory.
    assignMem_I64Code
            :: CmmExpr              -- ^ expr producing the destination address
            -> CmmExpr              -- ^ expr producing the source value.
            -> NatM InstrBlock

    assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
    assignMem_I64Code CmmExpr
    addrTree CmmExpr
    valueTree
     = do
         ChildCode64 InstrBlock
    vcode Reg
    rlo      <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    valueTree

         (Reg
    src, InstrBlock
    acode) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    addrTree
         let
             rhi :: Reg
    rhi = Reg -> Reg
    getHiVRegFromLo Reg
    rlo

             -- Big-endian store
             mov_hi :: Instr
    mov_hi = Format -> Reg -> AddrMode -> Instr
    ST Format
    II32 Reg
    rhi (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    src (Int -> Imm
    ImmInt Int
    0))
             mov_lo :: Instr
    mov_lo = Format -> Reg -> AddrMode -> Instr
    ST Format
    II32 Reg
    rlo (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    src (Int -> Imm
    ImmInt Int
    4))

             code :: InstrBlock
    code   = InstrBlock
    vcode InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` InstrBlock
    acode InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_hi InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_lo

    {-     pprTrace "assignMem_I64Code"
            (vcat   [ text "addrTree:  " <+> ppr addrTree
                    , text "valueTree: " <+> ppr valueTree
                    , text "vcode:"
                    , vcat $ map ppr $ fromOL vcode
                    , text ""
                    , text "acode:"
                    , vcat $ map ppr $ fromOL acode ])
           $ -}
         InstrBlock -> NatM InstrBlock
    forall (m :: * -> *) a. Monad m => a -> m a
    return InstrBlock
    code

    -- | Code to assign a 64 bit value to a register.
    assignReg_I64Code
            :: CmmReg               -- ^ the destination register
            -> CmmExpr              -- ^ expr producing the source value
            -> NatM InstrBlock

    assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock
    assignReg_I64Code (CmmLocal (LocalReg Unique
    u_dst CmmType
    pk)) CmmExpr
    valueTree
     = do
         ChildCode64 InstrBlock
    vcode Reg
    r_src_lo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    valueTree
         let
             r_dst_lo :: Reg
    r_dst_lo = VirtualReg -> Reg
    RegVirtual (VirtualReg -> Reg) -> VirtualReg -> Reg
    forall a b. (a -> b) -> a -> b
    $ Unique -> Format -> VirtualReg
    mkVirtualReg Unique
    u_dst (CmmType -> Format
    cmmTypeFormat CmmType
    pk)
             r_dst_hi :: Reg
    r_dst_hi = Reg -> Reg
    getHiVRegFromLo Reg
    r_dst_lo
             r_src_hi :: Reg
    r_src_hi = Reg -> Reg
    getHiVRegFromLo Reg
    r_src_lo
             mov_lo :: Instr
    mov_lo = Reg -> Reg -> Instr
    mkMOV Reg
    r_src_lo Reg
    r_dst_lo
             mov_hi :: Instr
    mov_hi = Reg -> Reg -> Instr
    mkMOV Reg
    r_src_hi Reg
    r_dst_hi
             mkMOV :: Reg -> Reg -> Instr
    mkMOV Reg
    sreg Reg
    dreg = Bool -> Reg -> RI -> Reg -> Instr
    OR Bool
    False Reg
    g0 (Reg -> RI
    RIReg Reg
    sreg) Reg
    dreg

         InstrBlock -> NatM InstrBlock
    forall (m :: * -> *) a. Monad m => a -> m a
    return (InstrBlock
    vcode InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_hi InstrBlock -> Instr -> InstrBlock
    forall a. OrdList a -> a -> OrdList a
    `snocOL` Instr
    mov_lo)

    assignReg_I64Code CmmReg
    _ CmmExpr
    _
       = String -> NatM InstrBlock
    forall a. String -> a
    panic String
    "assignReg_I64Code(sparc): invalid lvalue"

    -- | Get the value of an expression into a 64 bit register.

    iselExpr64 :: CmmExpr -> NatM ChildCode64

    -- Load a 64 bit word
    -- TODO: Check Ben
    iselExpr64 :: CmmExpr -> NatM ChildCode64
    iselExpr64 (CmmLoad CmmExpr
    addrTree CmmType
    ty AlignmentSpec
    _)
     | CmmType -> Bool
    isWord64 CmmType
    ty
     = do   Amode AddrMode
    amode InstrBlock
    addr_code   <- CmmExpr -> NatM Amode
    getAmode CmmExpr
    addrTree
            let result :: NatM ChildCode64
    result

                    | AddrRegReg Reg
    r1 Reg
    r2      <- AddrMode
    amode
                    = do    Reg
    rlo     <- Format -> NatM Reg
    getNewRegNat Format
    II32
                            Reg
    tmp     <- Format -> NatM Reg
    getNewRegNat Format
    II32
                            let rhi :: Reg
    rhi = Reg -> Reg
    getHiVRegFromLo Reg
    rlo

                            ChildCode64 -> NatM ChildCode64
    forall (m :: * -> *) a. Monad m => a -> m a
    return  (ChildCode64 -> NatM ChildCode64)
    -> ChildCode64 -> NatM ChildCode64
    forall a b. (a -> b) -> a -> b
    $ InstrBlock -> Reg -> ChildCode64
    ChildCode64
                                    (        InstrBlock
    addr_code
                                    InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  [Instr] -> InstrBlock
    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
    tmp
                                             , Format -> AddrMode -> Reg -> Instr
    LD Format
    II32 (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    tmp (Int -> Imm
    ImmInt Int
    0)) Reg
    rhi
                                             , Format -> AddrMode -> Reg -> Instr
    LD Format
    II32 (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    tmp (Int -> Imm
    ImmInt Int
    4)) Reg
    rlo ])
                                    Reg
    rlo

                    | AddrRegImm Reg
    r1 (ImmInt Int
    i) <- AddrMode
    amode
                    = do    Reg
    rlo     <- Format -> NatM Reg
    getNewRegNat Format
    II32
                            let rhi :: Reg
    rhi = Reg -> Reg
    getHiVRegFromLo Reg
    rlo

                            ChildCode64 -> NatM ChildCode64
    forall (m :: * -> *) a. Monad m => a -> m a
    return  (ChildCode64 -> NatM ChildCode64)
    -> ChildCode64 -> NatM ChildCode64
    forall a b. (a -> b) -> a -> b
    $ InstrBlock -> Reg -> ChildCode64
    ChildCode64
                                    (        InstrBlock
    addr_code
                                    InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL`  [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL
                                             [ Format -> AddrMode -> Reg -> Instr
    LD Format
    II32 (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    r1 (Int -> Imm
    ImmInt (Int -> Imm) -> Int -> Imm
    forall a b. (a -> b) -> a -> b
    $ Int
    0 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    i)) Reg
    rhi
                                             , Format -> AddrMode -> Reg -> Instr
    LD Format
    II32 (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    r1 (Int -> Imm
    ImmInt (Int -> Imm) -> Int -> Imm
    forall a b. (a -> b) -> a -> b
    $ Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    i)) Reg
    rlo ])
                                    Reg
    rlo

                    | Bool
    otherwise
                    = String -> NatM ChildCode64
    forall a. String -> a
    panic String
    "SPARC.CodeGen.Gen64: no match"

            NatM ChildCode64
    result

    -- Add a literal to a 64 bit integer
    iselExpr64 (CmmMachOp (MO_Add Width
    _) [CmmExpr
    e1, CmmLit (CmmInt Integer
    i Width
    _)])
     = do   ChildCode64 InstrBlock
    code1 Reg
    r1_lo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    e1
            let r1_hi :: Reg
    r1_hi       = Reg -> Reg
    getHiVRegFromLo Reg
    r1_lo

            Reg
    r_dst_lo        <- Format -> NatM Reg
    getNewRegNat Format
    II32
            let r_dst_hi :: Reg
    r_dst_hi    =  Reg -> Reg
    getHiVRegFromLo Reg
    r_dst_lo

            let code :: InstrBlock
    code =      InstrBlock
    code1
                    InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL
                            [ Bool -> Bool -> Reg -> RI -> Reg -> Instr
    ADD Bool
    False Bool
    True  Reg
    r1_lo (Imm -> RI
    RIImm (Integer -> Imm
    ImmInteger Integer
    i)) Reg
    r_dst_lo
                            , Bool -> Bool -> Reg -> RI -> Reg -> Instr
    ADD Bool
    True  Bool
    False Reg
    r1_hi (Reg -> RI
    RIReg Reg
    g0)         Reg
    r_dst_hi ]

            ChildCode64 -> NatM ChildCode64
    forall (m :: * -> *) a. Monad m => a -> m a
    return  (ChildCode64 -> NatM ChildCode64)
    -> ChildCode64 -> NatM ChildCode64
    forall a b. (a -> b) -> a -> b
    $ InstrBlock -> Reg -> ChildCode64
    ChildCode64 InstrBlock
    code Reg
    r_dst_lo

    -- Addition of II64
    iselExpr64 (CmmMachOp (MO_Add Width
    _) [CmmExpr
    e1, CmmExpr
    e2])
     = do   ChildCode64 InstrBlock
    code1 Reg
    r1_lo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    e1
            let r1_hi :: Reg
    r1_hi       = Reg -> Reg
    getHiVRegFromLo Reg
    r1_lo

            ChildCode64 InstrBlock
    code2 Reg
    r2_lo <- CmmExpr -> NatM ChildCode64
    iselExpr64 CmmExpr
    e2
            let r2_hi :: Reg
    r2_hi       = Reg -> Reg
    getHiVRegFromLo Reg
    r2_lo

            Reg
    r_dst_lo        <- Format -> NatM Reg
    getNewRegNat Format
    II32
            let r_dst_hi :: Reg
    r_dst_hi    = Reg -> Reg
    getHiVRegFromLo Reg
    r_dst_lo

            let code :: InstrBlock
    code =      InstrBlock
    code1
                    InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` InstrBlock
    code2
                    InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL
                            [ Bool -> Bool -> Reg -> RI -> Reg -> Instr
    ADD Bool
    False Bool
    True  Reg
    r1_lo (Reg -> RI
    RIReg Reg
    r2_lo) Reg
    r_dst_lo
                            , Bool -> Bool -> Reg -> RI -> Reg -> Instr
    ADD Bool
    True  Bool
    False Reg
    r1_hi (Reg -> RI
    RIReg Reg
    r2_hi) Reg
    r_dst_hi ]

            ChildCode64 -> NatM ChildCode64
    forall (m :: * -> *) a. Monad m => a -> m a
    return  (ChildCode64 -> NatM ChildCode64)
    -> ChildCode64 -> NatM ChildCode64
    forall a b. (a -> b) -> a -> b
    $ InstrBlock -> Reg -> ChildCode64
    ChildCode64 InstrBlock
    code Reg
    r_dst_lo

    iselExpr64 (CmmReg (CmmLocal (LocalReg Unique
    uq CmmType
    ty)))
     | CmmType -> Bool
    isWord64 CmmType
    ty
     = do
         Reg
    r_dst_lo <-  Format -> NatM Reg
    getNewRegNat Format
    II32
         let r_dst_hi :: Reg
    r_dst_hi = Reg -> Reg
    getHiVRegFromLo Reg
    r_dst_lo
             r_src_lo :: Reg
    r_src_lo = VirtualReg -> Reg
    RegVirtual (VirtualReg -> Reg) -> VirtualReg -> Reg
    forall a b. (a -> b) -> a -> b
    $ Unique -> Format -> VirtualReg
    mkVirtualReg Unique
    uq Format
    II32
             r_src_hi :: Reg
    r_src_hi = Reg -> Reg
    getHiVRegFromLo Reg
    r_src_lo
             mov_lo :: Instr
    mov_lo = Reg -> Reg -> Instr
    mkMOV Reg
    r_src_lo Reg
    r_dst_lo
             mov_hi :: Instr
    mov_hi = Reg -> Reg -> Instr
    mkMOV Reg
    r_src_hi Reg
    r_dst_hi
             mkMOV :: Reg -> Reg -> Instr
    mkMOV Reg
    sreg Reg
    dreg = Bool -> Reg -> RI -> Reg -> Instr
    OR Bool
    False Reg
    g0 (Reg -> RI
    RIReg Reg
    sreg) Reg
    dreg
         ChildCode64 -> NatM ChildCode64
    forall (m :: * -> *) a. Monad m => a -> m a
    return (
                InstrBlock -> Reg -> ChildCode64
    ChildCode64 ([Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL [Instr
    mov_hi, Instr
    mov_lo]) Reg
    r_dst_lo
             )

    -- Convert something into II64
    iselExpr64 (CmmMachOp (MO_UU_Conv Width
    _ Width
    W64) [CmmExpr
    expr])
     = do
            Reg
    r_dst_lo        <- Format -> NatM Reg
    getNewRegNat Format
    II32
            let r_dst_hi :: Reg
    r_dst_hi    = Reg -> Reg
    getHiVRegFromLo Reg
    r_dst_lo

            -- compute expr and load it into r_dst_lo
            (Reg
    a_reg, InstrBlock
    a_code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    expr

            Platform
    platform        <- NatM Platform
    getPlatform
            let code :: InstrBlock
    code        = InstrBlock
    a_code
                    InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL
                            [ Platform -> Reg -> Reg -> Instr
    mkRegRegMoveInstr Platform
    platform Reg
    g0    Reg
    r_dst_hi     -- clear high 32 bits
                            , Platform -> Reg -> Reg -> Instr
    mkRegRegMoveInstr Platform
    platform Reg
    a_reg Reg
    r_dst_lo ]

            ChildCode64 -> NatM ChildCode64
    forall (m :: * -> *) a. Monad m => a -> m a
    return  (ChildCode64 -> NatM ChildCode64)
    -> ChildCode64 -> NatM ChildCode64
    forall a b. (a -> b) -> a -> b
    $ InstrBlock -> Reg -> ChildCode64
    ChildCode64 InstrBlock
    code Reg
    r_dst_lo

    -- only W32 supported for now
    iselExpr64 (CmmMachOp (MO_SS_Conv Width
    W32 Width
    W64) [CmmExpr
    expr])
     = do
            Reg
    r_dst_lo        <- Format -> NatM Reg
    getNewRegNat Format
    II32
            let r_dst_hi :: Reg
    r_dst_hi    = Reg -> Reg
    getHiVRegFromLo Reg
    r_dst_lo

            -- compute expr and load it into r_dst_lo
            (Reg
    a_reg, InstrBlock
    a_code) <- CmmExpr -> NatM (Reg, InstrBlock)
    getSomeReg CmmExpr
    expr

            Platform
    platform        <- NatM Platform
    getPlatform
            let code :: InstrBlock
    code        = InstrBlock
    a_code
                    InstrBlock -> InstrBlock -> InstrBlock
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [Instr] -> InstrBlock
    forall a. [a] -> OrdList a
    toOL
                            [ Reg -> RI -> Reg -> Instr
    SRA Reg
    a_reg (Imm -> RI
    RIImm (Int -> Imm
    ImmInt Int
    31)) Reg
    r_dst_hi
                            , Platform -> Reg -> Reg -> Instr
    mkRegRegMoveInstr Platform
    platform Reg
    a_reg Reg
    r_dst_lo ]

            ChildCode64 -> NatM ChildCode64
    forall (m :: * -> *) a. Monad m => a -> m a
    return  (ChildCode64 -> NatM ChildCode64)
    -> ChildCode64 -> NatM ChildCode64
    forall a b. (a -> b) -> a -> b
    $ InstrBlock -> Reg -> ChildCode64
    ChildCode64 InstrBlock
    code Reg
    r_dst_lo

    iselExpr64 CmmExpr
    expr
       = do
          Platform
    platform <- NatM Platform
    getPlatform
          String -> SDoc -> NatM ChildCode64
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "iselExpr64(sparc)" (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    expr)