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

where

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 Size
import Reg

import Cmm

import OrdList
import Outputable

-- | Code to assign a 64 bit value to memory.
assignMem_I64Code 
	:: CmmExpr 		-- ^ expr producing the desination 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 (cmmTypeSize 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

	let code	= a_code
		`appOL`	toOL
			[ mkRegRegMoveInstr g0    r_dst_hi 	-- clear high 32 bits
			, mkRegRegMoveInstr a_reg r_dst_lo ]
			
	return	$ ChildCode64 code r_dst_lo


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