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

where

import GhcPrelude

import {-# SOURCE #-} SPARC.CodeGen.Gen32
import SPARC.CodeGen.Base
import SPARC.CodeGen.Amode
import SPARC.Regs
import SPARC.AddrMode
import SPARC.Imm
import SPARC.Instr
import SPARC.Ppr()
import NCGMonad
import Instruction
import Format
import Reg

import Cmm

import DynFlags
import OrdList
import Outputable

-- | 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 addrTree :: CmmExpr
addrTree valueTree :: CmmExpr
valueTree
 = do
     ChildCode64 vcode :: InstrBlock
vcode rlo :: Reg
rlo      <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
valueTree

     (src :: Reg
src, acode :: 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 0))
         mov_lo :: Instr
mov_lo = Format -> Reg -> AddrMode -> Instr
ST Format
II32 Reg
rlo (Reg -> Imm -> AddrMode
AddrRegImm Reg
src (Int -> Imm
ImmInt 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 u_dst :: Unique
u_dst pk :: CmmType
pk)) valueTree :: CmmExpr
valueTree
 = do
     ChildCode64 vcode :: InstrBlock
vcode r_src_lo :: 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 sreg :: Reg
sreg dreg :: 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 _ _
   = String -> NatM InstrBlock
forall a. String -> a
panic "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
iselExpr64 :: CmmExpr -> NatM ChildCode64
iselExpr64 (CmmLoad addrTree :: CmmExpr
addrTree ty :: CmmType
ty)
 | CmmType -> Bool
isWord64 CmmType
ty
 = do   Amode amode :: AddrMode
amode addr_code :: InstrBlock
addr_code   <- CmmExpr -> NatM Amode
getAmode CmmExpr
addrTree
        let result :: NatM ChildCode64
result

                | AddrRegReg r1 :: Reg
r1 r2 :: 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 0)) Reg
rhi
                                         , Format -> AddrMode -> Reg -> Instr
LD Format
II32 (Reg -> Imm -> AddrMode
AddrRegImm Reg
tmp (Int -> Imm
ImmInt 4)) Reg
rlo ])
                                Reg
rlo

                | AddrRegImm r1 :: Reg
r1 (ImmInt i :: 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
$ 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
$ 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 "SPARC.CodeGen.Gen64: no match"

        NatM ChildCode64
result


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

        ChildCode64 code2 :: InstrBlock
code2 r2_lo :: 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 uq :: Unique
uq ty :: 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 sreg :: Reg
sreg dreg :: 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 _ W64) [expr :: 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
        (a_reg :: Reg
a_reg, a_code :: InstrBlock
a_code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr

        DynFlags
dflags <- NatM DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        let platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
            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
forall instr. Instruction instr => Platform -> Reg -> Reg -> instr
mkRegRegMoveInstr Platform
platform Reg
g0    Reg
r_dst_hi     -- clear high 32 bits
                        , Platform -> Reg -> Reg -> Instr
forall instr. Instruction instr => 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 W32 W64) [expr :: 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
        (a_reg :: Reg
a_reg, a_code :: InstrBlock
a_code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr

        DynFlags
dflags          <- NatM DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        let platform :: Platform
platform    = DynFlags -> Platform
targetPlatform DynFlags
dflags
            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 31)) Reg
r_dst_hi
                        , Platform -> Reg -> Reg -> Instr
forall instr. Instruction instr => 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 expr :: CmmExpr
expr
   = String -> SDoc -> NatM ChildCode64
forall a. HasCallStack => String -> SDoc -> a
pprPanic "iselExpr64(sparc)" (CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmExpr
expr)