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
assignMem_I64Code
:: CmmExpr
-> CmmExpr
-> 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
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 forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
acode forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_hi forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_lo
forall (m :: * -> *) a. Monad m => a -> m a
return InstrBlock
code
assignReg_I64Code
:: CmmReg
-> CmmExpr
-> 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 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
forall (m :: * -> *) a. Monad m => a -> m a
return (InstrBlock
vcode forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_hi forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_lo)
assignReg_I64Code CmmReg
_ CmmExpr
_
= forall a. String -> a
panic String
"assignReg_I64Code(sparc): invalid lvalue"
iselExpr64 :: CmmExpr -> NatM ChildCode64
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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ InstrBlock -> Reg -> ChildCode64
ChildCode64
( InstrBlock
addr_code
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ InstrBlock -> Reg -> ChildCode64
ChildCode64
( InstrBlock
addr_code
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL
[ Format -> AddrMode -> Reg -> Instr
LD Format
II32 (Reg -> Imm -> AddrMode
AddrRegImm Reg
r1 (Int -> Imm
ImmInt forall a b. (a -> b) -> a -> b
$ Int
0 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 forall a b. (a -> b) -> a -> b
$ Int
4 forall a. Num a => a -> a -> a
+ Int
i)) Reg
rlo ])
Reg
rlo
| Bool
otherwise
= forall a. String -> a
panic String
"SPARC.CodeGen.Gen64: no match"
NatM ChildCode64
result
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
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` 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 ]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ InstrBlock -> Reg -> ChildCode64
ChildCode64 InstrBlock
code Reg
r_dst_lo
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
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
code2
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` 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 ]
forall (m :: * -> *) a. Monad m => a -> m a
return 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 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
forall (m :: * -> *) a. Monad m => a -> m a
return (
InstrBlock -> Reg -> ChildCode64
ChildCode64 (forall a. [a] -> OrdList a
toOL [Instr
mov_hi, Instr
mov_lo]) Reg
r_dst_lo
)
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
(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
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL
[ Platform -> Reg -> Reg -> Instr
mkRegRegMoveInstr Platform
platform Reg
g0 Reg
r_dst_hi
, Platform -> Reg -> Reg -> Instr
mkRegRegMoveInstr Platform
platform Reg
a_reg Reg
r_dst_lo ]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ InstrBlock -> Reg -> ChildCode64
ChildCode64 InstrBlock
code Reg
r_dst_lo
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
(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
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` 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 ]
forall (m :: * -> *) a. Monad m => a -> m a
return 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
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"iselExpr64(sparc)" (forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
expr)