-- | 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 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
iselExpr64 :: CmmExpr -> NatM ChildCode64
iselExpr64 (CmmLoad CmmExpr
addrTree CmmType
ty)
 | 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

        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 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

        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 Int
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 CmmExpr
expr
   = String -> SDoc -> NatM ChildCode64
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"iselExpr64(sparc)" (CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmExpr
expr)