-- | 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
-- GHC.CmmToAsm.SPARC.Ppr()
import GHC.CmmToAsm.Monad
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.Format
import GHC.Platform.Reg

import GHC.Cmm

import GHC.Data.OrdList
import GHC.Utils.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 addrTree valueTree
 = do
     ChildCode64 vcode rlo      <- iselExpr64 valueTree

     (src, acode) <- getSomeReg addrTree
     let
         rhi = getHiVRegFromLo rlo

         -- Big-endian store
         mov_hi = ST II32 rhi (AddrRegImm src (ImmInt 0))
         mov_lo = ST II32 rlo (AddrRegImm src (ImmInt 4))

         code   = vcode `appOL` acode `snocOL` mov_hi `snocOL` 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 ])
       $ -}
     return 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 (CmmLocal (LocalReg u_dst pk)) valueTree
 = do
     ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
     let
         r_dst_lo = RegVirtual $ mkVirtualReg u_dst (cmmTypeFormat pk)
         r_dst_hi = getHiVRegFromLo r_dst_lo
         r_src_hi = getHiVRegFromLo r_src_lo
         mov_lo = mkMOV r_src_lo r_dst_lo
         mov_hi = mkMOV r_src_hi r_dst_hi
         mkMOV sreg dreg = OR False g0 (RIReg sreg) dreg

     return (vcode `snocOL` mov_hi `snocOL` mov_lo)

assignReg_I64Code _ _
   = 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 (CmmLoad addrTree ty)
 | isWord64 ty
 = do   Amode amode addr_code   <- getAmode addrTree
        let result

                | AddrRegReg r1 r2      <- amode
                = do    rlo     <- getNewRegNat II32
                        tmp     <- getNewRegNat II32
                        let rhi = getHiVRegFromLo rlo

                        return  $ ChildCode64
                                (        addr_code
                                `appOL`  toOL
                                         [ ADD False False r1 (RIReg r2) tmp
                                         , LD II32 (AddrRegImm tmp (ImmInt 0)) rhi
                                         , LD II32 (AddrRegImm tmp (ImmInt 4)) rlo ])
                                rlo

                | AddrRegImm r1 (ImmInt i) <- amode
                = do    rlo     <- getNewRegNat II32
                        let rhi = getHiVRegFromLo rlo

                        return  $ ChildCode64
                                (        addr_code
                                `appOL`  toOL
                                         [ LD II32 (AddrRegImm r1 (ImmInt $ 0 + i)) rhi
                                         , LD II32 (AddrRegImm r1 (ImmInt $ 4 + i)) rlo ])
                                rlo

                | otherwise
                = panic "SPARC.CodeGen.Gen64: no match"

        result


-- Add a literal to a 64 bit integer
iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)])
 = do   ChildCode64 code1 r1_lo <- iselExpr64 e1
        let r1_hi       = getHiVRegFromLo r1_lo

        r_dst_lo        <- getNewRegNat II32
        let r_dst_hi    =  getHiVRegFromLo r_dst_lo

        let code =      code1
                `appOL` toOL
                        [ ADD False True  r1_lo (RIImm (ImmInteger i)) r_dst_lo
                        , ADD True  False r1_hi (RIReg g0)         r_dst_hi ]

        return  $ ChildCode64 code r_dst_lo


-- Addition of II64
iselExpr64 (CmmMachOp (MO_Add _) [e1, e2])
 = do   ChildCode64 code1 r1_lo <- iselExpr64 e1
        let r1_hi       = getHiVRegFromLo r1_lo

        ChildCode64 code2 r2_lo <- iselExpr64 e2
        let r2_hi       = getHiVRegFromLo r2_lo

        r_dst_lo        <- getNewRegNat II32
        let r_dst_hi    = getHiVRegFromLo r_dst_lo

        let code =      code1
                `appOL` code2
                `appOL` toOL
                        [ ADD False True  r1_lo (RIReg r2_lo) r_dst_lo
                        , ADD True  False r1_hi (RIReg r2_hi) r_dst_hi ]

        return  $ ChildCode64 code r_dst_lo


iselExpr64 (CmmReg (CmmLocal (LocalReg uq ty)))
 | isWord64 ty
 = do
     r_dst_lo <-  getNewRegNat II32
     let r_dst_hi = getHiVRegFromLo r_dst_lo
         r_src_lo = RegVirtual $ mkVirtualReg uq II32
         r_src_hi = getHiVRegFromLo r_src_lo
         mov_lo = mkMOV r_src_lo r_dst_lo
         mov_hi = mkMOV r_src_hi r_dst_hi
         mkMOV sreg dreg = OR False g0 (RIReg sreg) dreg
     return (
            ChildCode64 (toOL [mov_hi, mov_lo]) r_dst_lo
         )

-- Convert something into II64
iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr])
 = do
        r_dst_lo        <- getNewRegNat II32
        let r_dst_hi    = getHiVRegFromLo r_dst_lo

        -- compute expr and load it into r_dst_lo
        (a_reg, a_code) <- getSomeReg expr

        platform        <- getPlatform
        let code        = a_code
                `appOL` toOL
                        [ mkRegRegMoveInstr platform g0    r_dst_hi     -- clear high 32 bits
                        , mkRegRegMoveInstr platform a_reg r_dst_lo ]

        return  $ ChildCode64 code r_dst_lo

-- only W32 supported for now
iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr])
 = do
        r_dst_lo        <- getNewRegNat II32
        let r_dst_hi    = getHiVRegFromLo r_dst_lo

        -- compute expr and load it into r_dst_lo
        (a_reg, a_code) <- getSomeReg expr

        platform        <- getPlatform
        let code        = a_code
                `appOL` toOL
                        [ SRA a_reg (RIImm (ImmInt 31)) r_dst_hi
                        , mkRegRegMoveInstr platform a_reg r_dst_lo ]

        return  $ ChildCode64 code r_dst_lo


iselExpr64 expr
   = pprPanic "iselExpr64(sparc)" (ppr expr)