summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2022-02-18 12:42:23 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-02-23 13:59:23 -0500
commit6fa7591e832d71ebea452ee6ddf97ac513404576 (patch)
tree7f83a642cb2e3f3be0fac0e69259491b93735f0f /compiler
parentf07b13e38a24d73db152f465922d0fcf903e0470 (diff)
downloadhaskell-6fa7591e832d71ebea452ee6ddf97ac513404576.tar.gz
NCG: refactor the way registers are handled
* add getLocalRegReg to avoid allocating a CmmLocal just to call getRegisterReg * 64-bit registers: in the general case we must always use the virtual higher part of the register, so we might as well always return it with the lower part. The only exception is to implement 64-bit to 32-bit conversions. We now have to explicitly discard the higher part when matching on Reg64/RegCode64 datatypes instead of explicitly fetching the higher part from the lower part: much safer default.
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/CmmToAsm/Monad.hs50
-rw-r--r--compiler/GHC/CmmToAsm/PPC/CodeGen.hs220
-rw-r--r--compiler/GHC/CmmToAsm/X86/CodeGen.hs228
3 files changed, 229 insertions, 269 deletions
diff --git a/compiler/GHC/CmmToAsm/Monad.hs b/compiler/GHC/CmmToAsm/Monad.hs
index 5ae6785706..bb22c0425d 100644
--- a/compiler/GHC/CmmToAsm/Monad.hs
+++ b/compiler/GHC/CmmToAsm/Monad.hs
@@ -29,7 +29,6 @@ module GHC.CmmToAsm.Monad (
getBlockIdNat,
getNewLabelNat,
getNewRegNat,
- getNewRegPairNat,
getPicBaseMaybeNat,
getPicBaseNat,
getCfgWeights,
@@ -37,7 +36,11 @@ module GHC.CmmToAsm.Monad (
getFileId,
getDebugBlock,
- DwarfFiles
+ DwarfFiles,
+
+ -- * 64-bit registers on 32-bit architectures
+ Reg64(..), RegCode64(..),
+ getNewReg64, localReg64
)
where
@@ -56,6 +59,8 @@ import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.CLabel ( CLabel )
import GHC.Cmm.DebugBlock
+import GHC.Cmm.Expr (LocalReg (..), isWord64)
+
import GHC.Data.FastString ( FastString )
import GHC.Types.Unique.FM
import GHC.Types.Unique.Supply
@@ -66,6 +71,7 @@ import Control.Monad ( ap )
import GHC.Utils.Outputable (SDoc, ppr)
import GHC.Utils.Panic (pprPanic)
+import GHC.Utils.Misc
import GHC.CmmToAsm.CFG
import GHC.CmmToAsm.CFG.Weight
@@ -254,14 +260,38 @@ getNewRegNat rep
return (RegVirtual $ targetMkVirtualReg platform u rep)
-getNewRegPairNat :: Format -> NatM (Reg,Reg)
-getNewRegPairNat rep
- = do u <- getUniqueNat
- platform <- getPlatform
- let vLo = targetMkVirtualReg platform u rep
- let lo = RegVirtual $ targetMkVirtualReg platform u rep
- let hi = RegVirtual $ getHiVirtualRegFromLo vLo
- return (lo, hi)
+-- | Two 32-bit regs used as a single virtual 64-bit register
+data Reg64 = Reg64
+ !Reg -- ^ Higher part
+ !Reg -- ^ Lower part
+
+-- | Two 32-bit regs used as a single virtual 64-bit register
+-- and the code to set them appropriately
+data RegCode64 code = RegCode64
+ code -- ^ Code to initialize the registers
+ !Reg -- ^ Higher part
+ !Reg -- ^ Lower part
+
+-- | Return a virtual 64-bit register
+getNewReg64 :: NatM Reg64
+getNewReg64 = do
+ let rep = II32
+ u <- getUniqueNat
+ platform <- getPlatform
+ let vLo = targetMkVirtualReg platform u rep
+ let lo = RegVirtual $ targetMkVirtualReg platform u rep
+ let hi = RegVirtual $ getHiVirtualRegFromLo vLo
+ return $ Reg64 hi lo
+
+-- | Convert a 64-bit LocalReg into two virtual 32-bit regs.
+--
+-- Used to handle 64-bit "registers" on 32-bit architectures
+localReg64 :: HasDebugCallStack => LocalReg -> Reg64
+localReg64 (LocalReg vu ty)
+ | isWord64 ty = let lo = RegVirtual (VirtualRegI vu)
+ hi = getHiVRegFromLo lo
+ in Reg64 hi lo
+ | otherwise = pprPanic "localReg64" (ppr ty)
getPicBaseMaybeNat :: NatM (Maybe Reg)
diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index 02308c59e0..6d7f61d56d 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -33,7 +33,8 @@ import GHC.Cmm.DebugBlock
( DebugBlock(..) )
import GHC.CmmToAsm.Monad
( NatM, getNewRegNat, getNewLabelNat
- , getBlockIdNat, getPicBaseNat, getNewRegPairNat
+ , getBlockIdNat, getPicBaseNat
+ , Reg64(..), RegCode64(..), getNewReg64, localReg64
, getPicBaseMaybeNat, getPlatform, getConfig
, getDebugBlock, getFileId
)
@@ -222,12 +223,15 @@ swizzleRegisterRep :: Register -> Format -> Register
swizzleRegisterRep (Fixed _ reg code) format = Fixed format reg code
swizzleRegisterRep (Any _ codefn) format = Any format codefn
+getLocalRegReg :: LocalReg -> Reg
+getLocalRegReg (LocalReg u pk)
+ = RegVirtual (mkVirtualReg u (cmmTypeFormat pk))
-- | Grab the Reg for a CmmReg
getRegisterReg :: Platform -> CmmReg -> Reg
-getRegisterReg _ (CmmLocal (LocalReg u pk))
- = RegVirtual $ mkVirtualReg u (cmmTypeFormat pk)
+getRegisterReg _ (CmmLocal local_reg)
+ = getLocalRegReg local_reg
getRegisterReg platform (CmmGlobal mid)
= case globalRegMaybe platform mid of
@@ -274,16 +278,6 @@ of the VRegUniqueLo form, and the upper-half VReg can be determined
by applying getHiVRegFromLo to it.
-}
-data ChildCode64 -- a.k.a "Register64"
- = ChildCode64
- InstrBlock -- code
- Reg -- the lower 32-bit temporary which contains the
- -- result; use getHiVRegFromLo to find the other
- -- VRegUnique. Rules of this simplified insn
- -- selection game are therefore that the returned
- -- Reg may be modified
-
-
-- | Compute an expression into a register, but
-- we don't mind which one it is.
getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
@@ -310,10 +304,8 @@ getI64Amodes addrTree = do
assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_I64Code addrTree valueTree = do
(hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
- ChildCode64 vcode rlo <- iselExpr64 valueTree
+ RegCode64 vcode rhi rlo <- iselExpr64 valueTree
let
- rhi = getHiVRegFromLo rlo
-
-- Big-endian store
mov_hi = ST II32 rhi hi_addr
mov_lo = ST II32 rlo lo_addr
@@ -321,14 +313,11 @@ assignMem_I64Code addrTree valueTree = do
assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock
-assignReg_I64Code (CmmLocal (LocalReg u_dst _)) valueTree = do
- ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
- let
- r_dst_lo = RegVirtual $ mkVirtualReg u_dst II32
- r_dst_hi = getHiVRegFromLo r_dst_lo
- r_src_hi = getHiVRegFromLo r_src_lo
- mov_lo = MR r_dst_lo r_src_lo
- mov_hi = MR r_dst_hi r_src_hi
+assignReg_I64Code (CmmLocal lreg) valueTree = do
+ RegCode64 vcode r_src_hi r_src_lo <- iselExpr64 valueTree
+ let Reg64 r_dst_hi r_dst_lo = localReg64 lreg
+ mov_lo = MR r_dst_lo r_src_lo
+ mov_hi = MR r_dst_hi r_src_hi
return (
vcode `snocOL` mov_lo `snocOL` mov_hi
)
@@ -337,20 +326,21 @@ assignReg_I64Code _ _
= panic "assignReg_I64Code(powerpc): invalid lvalue"
-iselExpr64 :: CmmExpr -> NatM ChildCode64
+iselExpr64 :: CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 (CmmLoad addrTree ty _) | isWord64 ty = do
(hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
- (rlo, rhi) <- getNewRegPairNat II32
+ Reg64 rhi rlo <- getNewReg64
let mov_hi = LD II32 rhi hi_addr
mov_lo = LD II32 rlo lo_addr
- return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
- rlo
+ return $ RegCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
+ rhi rlo
-iselExpr64 (CmmReg (CmmLocal (LocalReg vu ty))) | isWord64 ty
- = return (ChildCode64 nilOL (RegVirtual $ mkVirtualReg vu II32))
+iselExpr64 (CmmReg (CmmLocal local_reg)) = do
+ let Reg64 hi lo = localReg64 local_reg
+ return (RegCode64 nilOL hi lo)
iselExpr64 (CmmLit (CmmInt i _)) = do
- (rlo,rhi) <- getNewRegPairNat II32
+ Reg64 rhi rlo <- getNewReg64
let
half0 = fromIntegral (fromIntegral i :: Word16)
half1 = fromIntegral (fromIntegral (i `shiftR` 16) :: Word16)
@@ -363,49 +353,45 @@ iselExpr64 (CmmLit (CmmInt i _)) = do
LIS rhi (ImmInt half3),
OR rhi rhi (RIImm $ ImmInt half2)
]
- return (ChildCode64 code rlo)
+ return (RegCode64 code rhi rlo)
iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
- ChildCode64 code1 r1lo <- iselExpr64 e1
- ChildCode64 code2 r2lo <- iselExpr64 e2
- (rlo,rhi) <- getNewRegPairNat II32
+ RegCode64 code1 r1hi r1lo <- iselExpr64 e1
+ RegCode64 code2 r2hi r2lo <- iselExpr64 e2
+ Reg64 rhi rlo <- getNewReg64
let
- r1hi = getHiVRegFromLo r1lo
- r2hi = getHiVRegFromLo r2lo
code = code1 `appOL`
code2 `appOL`
toOL [ ADDC rlo r1lo r2lo,
ADDE rhi r1hi r2hi ]
- return (ChildCode64 code rlo)
+ return (RegCode64 code rhi rlo)
iselExpr64 (CmmMachOp (MO_Sub _) [e1,e2]) = do
- ChildCode64 code1 r1lo <- iselExpr64 e1
- ChildCode64 code2 r2lo <- iselExpr64 e2
- (rlo,rhi) <- getNewRegPairNat II32
+ RegCode64 code1 r1hi r1lo <- iselExpr64 e1
+ RegCode64 code2 r2hi r2lo <- iselExpr64 e2
+ Reg64 rhi rlo <- getNewReg64
let
- r1hi = getHiVRegFromLo r1lo
- r2hi = getHiVRegFromLo r2lo
code = code1 `appOL`
code2 `appOL`
toOL [ SUBFC rlo r2lo (RIReg r1lo),
SUBFE rhi r2hi r1hi ]
- return (ChildCode64 code rlo)
+ return (RegCode64 code rhi rlo)
iselExpr64 (CmmMachOp (MO_UU_Conv W32 W64) [expr]) = do
(expr_reg,expr_code) <- getSomeReg expr
- (rlo, rhi) <- getNewRegPairNat II32
+ Reg64 rhi rlo <- getNewReg64
let mov_hi = LI rhi (ImmInt 0)
mov_lo = MR rlo expr_reg
- return $ ChildCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)
- rlo
+ return $ RegCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)
+ rhi rlo
iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do
(expr_reg,expr_code) <- getSomeReg expr
- (rlo, rhi) <- getNewRegPairNat II32
+ Reg64 rhi rlo <- getNewReg64
let mov_hi = SRA II32 rhi expr_reg (RIImm (ImmInt 31))
mov_lo = MR rlo expr_reg
- return $ ChildCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)
- rlo
+ return $ RegCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)
+ rhi rlo
iselExpr64 expr
= do
platform <- getPlatform
@@ -443,23 +429,23 @@ getRegister' config platform tree@(CmmRegOff _ _)
getRegister' _ platform (CmmMachOp (MO_UU_Conv W64 W32)
[CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]])
| target32Bit platform = do
- ChildCode64 code rlo <- iselExpr64 x
+ RegCode64 code _rhi rlo <- iselExpr64 x
return $ Fixed II32 (getHiVRegFromLo rlo) code
getRegister' _ platform (CmmMachOp (MO_SS_Conv W64 W32)
[CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]])
| target32Bit platform = do
- ChildCode64 code rlo <- iselExpr64 x
+ RegCode64 code _rhi rlo <- iselExpr64 x
return $ Fixed II32 (getHiVRegFromLo rlo) code
getRegister' _ platform (CmmMachOp (MO_UU_Conv W64 W32) [x])
| target32Bit platform = do
- ChildCode64 code rlo <- iselExpr64 x
+ RegCode64 code _rhi rlo <- iselExpr64 x
return $ Fixed II32 rlo code
getRegister' _ platform (CmmMachOp (MO_SS_Conv W64 W32) [x])
| target32Bit platform = do
- ChildCode64 code rlo <- iselExpr64 x
+ RegCode64 code _rhi rlo <- iselExpr64 x
return $ Fixed II32 rlo code
getRegister' _ platform (CmmLoad mem pk _)
@@ -927,10 +913,8 @@ condIntCode' :: Bool -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode' True cond W64 x y
| condUnsigned cond
= do
- ChildCode64 code_x x_lo <- iselExpr64 x
- ChildCode64 code_y y_lo <- iselExpr64 y
- let x_hi = getHiVRegFromLo x_lo
- y_hi = getHiVRegFromLo y_lo
+ RegCode64 code_x x_hi x_lo <- iselExpr64 x
+ RegCode64 code_y y_hi y_lo <- iselExpr64 y
end_lbl <- getBlockIdNat
let code = code_x `appOL` code_y `appOL` toOL
[ CMPL II32 x_hi (RIReg y_hi)
@@ -943,10 +927,8 @@ condIntCode' True cond W64 x y
return (CondCode False cond code)
| otherwise
= do
- ChildCode64 code_x x_lo <- iselExpr64 x
- ChildCode64 code_y y_lo <- iselExpr64 y
- let x_hi = getHiVRegFromLo x_lo
- y_hi = getHiVRegFromLo y_lo
+ RegCode64 code_x x_hi x_lo <- iselExpr64 x
+ RegCode64 code_y y_hi y_lo <- iselExpr64 y
end_lbl <- getBlockIdNat
cmp_lo <- getBlockIdNat
let code = code_x `appOL` code_y `appOL` toOL
@@ -1143,9 +1125,8 @@ genCCall (PrimTarget (MO_Prefetch_Data _)) _ _
= return $ nilOL
genCCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n]
- = do platform <- getPlatform
- let fmt = intFormat width
- reg_dst = getRegisterReg platform (CmmLocal dst)
+ = do let fmt = intFormat width
+ reg_dst = getLocalRegReg dst
(instr, n_code) <- case amop of
AMO_Add -> getSomeRegOrImm ADD True reg_dst
AMO_Sub -> case n of
@@ -1194,9 +1175,8 @@ genCCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n]
return (op dst dst (RIReg n_reg), n_code)
genCCall (PrimTarget (MO_AtomicRead width)) [dst] [addr]
- = do platform <- getPlatform
- let fmt = intFormat width
- reg_dst = getRegisterReg platform (CmmLocal dst)
+ = do let fmt = intFormat width
+ reg_dst = getLocalRegReg dst
form = if widthInBits width == 64 then DS else D
Amode addr_reg addr_code <- getAmode form addr
lbl_end <- getBlockIdNat
@@ -1228,14 +1208,13 @@ genCCall (PrimTarget (MO_AtomicWrite width)) [] [addr, val] = do
genCCall (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new]
| width == W32 || width == W64
= do
- platform <- getPlatform
(old_reg, old_code) <- getSomeReg old
(new_reg, new_code) <- getSomeReg new
(addr_reg, addr_code) <- getSomeReg addr
lbl_retry <- getBlockIdNat
lbl_eq <- getBlockIdNat
lbl_end <- getBlockIdNat
- let reg_dst = getRegisterReg platform (CmmLocal dst)
+ let reg_dst = getLocalRegReg dst
code = toOL
[ HWSYNC
, BCC ALWAYS lbl_retry Nothing
@@ -1258,15 +1237,14 @@ genCCall (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new]
genCCall (PrimTarget (MO_Clz width)) [dst] [src]
= do platform <- getPlatform
- let reg_dst = getRegisterReg platform (CmmLocal dst)
+ let reg_dst = getLocalRegReg dst
if target32Bit platform && width == W64
then do
- ChildCode64 code vr_lo <- iselExpr64 src
+ RegCode64 code vr_hi vr_lo <- iselExpr64 src
lbl1 <- getBlockIdNat
lbl2 <- getBlockIdNat
lbl3 <- getBlockIdNat
- let vr_hi = getHiVRegFromLo vr_lo
- cntlz = toOL [ CMPL II32 vr_hi (RIImm (ImmInt 0))
+ let cntlz = toOL [ CMPL II32 vr_hi (RIImm (ImmInt 0))
, BCC NE lbl2 Nothing
, BCC ALWAYS lbl1 Nothing
@@ -1309,11 +1287,11 @@ genCCall (PrimTarget (MO_Clz width)) [dst] [src]
genCCall (PrimTarget (MO_Ctz width)) [dst] [src]
= do platform <- getPlatform
- let reg_dst = getRegisterReg platform (CmmLocal dst)
+ let reg_dst = getLocalRegReg dst
if target32Bit platform && width == W64
then do
let format = II32
- ChildCode64 code vr_lo <- iselExpr64 src
+ RegCode64 code vr_hi vr_lo <- iselExpr64 src
lbl1 <- getBlockIdNat
lbl2 <- getBlockIdNat
lbl3 <- getBlockIdNat
@@ -1321,8 +1299,7 @@ genCCall (PrimTarget (MO_Ctz width)) [dst] [src]
x'' <- getNewRegNat format
r' <- getNewRegNat format
cnttzlo <- cnttz format reg_dst vr_lo
- let vr_hi = getHiVRegFromLo vr_lo
- cnttz64 = toOL [ CMPL format vr_lo (RIImm (ImmInt 0))
+ let cnttz64 = toOL [ CMPL format vr_lo (RIImm (ImmInt 0))
, BCC NE lbl2 Nothing
, BCC ALWAYS lbl1 Nothing
@@ -1375,38 +1352,38 @@ genCCall (PrimTarget (MO_Ctz width)) [dst] [src]
genCCall target dest_regs argsAndHints
= do platform <- getPlatform
case target of
- PrimTarget (MO_S_QuotRem width) -> divOp1 platform True width
+ PrimTarget (MO_S_QuotRem width) -> divOp1 True width
dest_regs argsAndHints
- PrimTarget (MO_U_QuotRem width) -> divOp1 platform False width
+ PrimTarget (MO_U_QuotRem width) -> divOp1 False width
dest_regs argsAndHints
- PrimTarget (MO_U_QuotRem2 width) -> divOp2 platform width dest_regs
+ PrimTarget (MO_U_QuotRem2 width) -> divOp2 width dest_regs
argsAndHints
- PrimTarget (MO_U_Mul2 width) -> multOp2 platform width dest_regs
+ PrimTarget (MO_U_Mul2 width) -> multOp2 width dest_regs
argsAndHints
- PrimTarget (MO_Add2 _) -> add2Op platform dest_regs argsAndHints
- PrimTarget (MO_AddWordC _) -> addcOp platform dest_regs argsAndHints
- PrimTarget (MO_SubWordC _) -> subcOp platform dest_regs argsAndHints
- PrimTarget (MO_AddIntC width) -> addSubCOp ADDO platform width
+ PrimTarget (MO_Add2 _) -> add2Op dest_regs argsAndHints
+ PrimTarget (MO_AddWordC _) -> addcOp dest_regs argsAndHints
+ PrimTarget (MO_SubWordC _) -> subcOp dest_regs argsAndHints
+ PrimTarget (MO_AddIntC width) -> addSubCOp ADDO width
dest_regs argsAndHints
- PrimTarget (MO_SubIntC width) -> addSubCOp SUBFO platform width
+ PrimTarget (MO_SubIntC width) -> addSubCOp SUBFO width
dest_regs argsAndHints
- PrimTarget MO_F64_Fabs -> fabs platform dest_regs argsAndHints
- PrimTarget MO_F32_Fabs -> fabs platform dest_regs argsAndHints
+ PrimTarget MO_F64_Fabs -> fabs dest_regs argsAndHints
+ PrimTarget MO_F32_Fabs -> fabs dest_regs argsAndHints
_ -> do config <- getConfig
genCCall' config (platformToGCP platform)
target dest_regs argsAndHints
- where divOp1 platform signed width [res_q, res_r] [arg_x, arg_y]
- = do let reg_q = getRegisterReg platform (CmmLocal res_q)
- reg_r = getRegisterReg platform (CmmLocal res_r)
+ where divOp1 signed width [res_q, res_r] [arg_x, arg_y]
+ = do let reg_q = getLocalRegReg res_q
+ reg_r = getLocalRegReg res_r
remainderCode width signed reg_q arg_x arg_y
<*> pure reg_r
- divOp1 _ _ _ _ _
+ divOp1 _ _ _ _
= panic "genCCall: Wrong number of arguments for divOp1"
- divOp2 platform width [res_q, res_r]
+ divOp2 width [res_q, res_r]
[arg_x_high, arg_x_low, arg_y]
- = do let reg_q = getRegisterReg platform (CmmLocal res_q)
- reg_r = getRegisterReg platform (CmmLocal res_r)
+ = do let reg_q = getLocalRegReg res_q
+ reg_r = getLocalRegReg res_r
fmt = intFormat width
half = 4 * (formatInBytes fmt)
(xh_reg, xh_code) <- getSomeReg arg_x_high
@@ -1543,11 +1520,11 @@ genCCall target dest_regs argsAndHints
, SL fmt reg_q q1 (RIImm (ImmInt half))
, ADD reg_q reg_q (RIReg q0)
]
- divOp2 _ _ _ _
+ divOp2 _ _ _
= panic "genCCall: Wrong number of arguments for divOp2"
- multOp2 platform width [res_h, res_l] [arg_x, arg_y]
- = do let reg_h = getRegisterReg platform (CmmLocal res_h)
- reg_l = getRegisterReg platform (CmmLocal res_l)
+ multOp2 width [res_h, res_l] [arg_x, arg_y]
+ = do let reg_h = getLocalRegReg res_h
+ reg_l = getLocalRegReg res_l
fmt = intFormat width
(x_reg, x_code) <- getSomeReg arg_x
(y_reg, y_code) <- getSomeReg arg_y
@@ -1555,11 +1532,11 @@ genCCall target dest_regs argsAndHints
`appOL` toOL [ MULL fmt reg_l x_reg (RIReg y_reg)
, MULHU fmt reg_h x_reg y_reg
]
- multOp2 _ _ _ _
+ multOp2 _ _ _
= panic "genCall: Wrong number of arguments for multOp2"
- add2Op platform [res_h, res_l] [arg_x, arg_y]
- = do let reg_h = getRegisterReg platform (CmmLocal res_h)
- reg_l = getRegisterReg platform (CmmLocal res_l)
+ add2Op [res_h, res_l] [arg_x, arg_y]
+ = do let reg_h = getLocalRegReg res_h
+ reg_l = getLocalRegReg res_l
(x_reg, x_code) <- getSomeReg arg_x
(y_reg, y_code) <- getSomeReg arg_y
return $ y_code `appOL` x_code
@@ -1567,20 +1544,20 @@ genCCall target dest_regs argsAndHints
, ADDC reg_l x_reg y_reg
, ADDZE reg_h reg_h
]
- add2Op _ _ _
+ add2Op _ _
= panic "genCCall: Wrong number of arguments/results for add2"
- addcOp platform [res_r, res_c] [arg_x, arg_y]
- = add2Op platform [res_c {-hi-}, res_r {-lo-}] [arg_x, arg_y]
- addcOp _ _ _
+ addcOp [res_r, res_c] [arg_x, arg_y]
+ = add2Op [res_c {-hi-}, res_r {-lo-}] [arg_x, arg_y]
+ addcOp _ _
= panic "genCCall: Wrong number of arguments/results for addc"
-- PowerPC subfc sets the carry for rT = ~(rA) + rB + 1,
-- which is 0 for borrow and 1 otherwise. We need 1 and 0
-- so xor with 1.
- subcOp platform [res_r, res_c] [arg_x, arg_y]
- = do let reg_r = getRegisterReg platform (CmmLocal res_r)
- reg_c = getRegisterReg platform (CmmLocal res_c)
+ subcOp [res_r, res_c] [arg_x, arg_y]
+ = do let reg_r = getLocalRegReg res_r
+ reg_c = getLocalRegReg res_c
(x_reg, x_code) <- getSomeReg arg_x
(y_reg, y_code) <- getSomeReg arg_y
return $ y_code `appOL` x_code
@@ -1589,11 +1566,11 @@ genCCall target dest_regs argsAndHints
, ADDZE reg_c reg_c
, XOR reg_c reg_c (RIImm (ImmInt 1))
]
- subcOp _ _ _
+ subcOp _ _
= panic "genCCall: Wrong number of arguments/results for subc"
- addSubCOp instr platform width [res_r, res_c] [arg_x, arg_y]
- = do let reg_r = getRegisterReg platform (CmmLocal res_r)
- reg_c = getRegisterReg platform (CmmLocal res_c)
+ addSubCOp instr width [res_r, res_c] [arg_x, arg_y]
+ = do let reg_r = getLocalRegReg res_r
+ reg_c = getLocalRegReg res_c
(x_reg, x_code) <- getSomeReg arg_x
(y_reg, y_code) <- getSomeReg arg_y
return $ y_code `appOL` x_code
@@ -1601,13 +1578,13 @@ genCCall target dest_regs argsAndHints
-- SUBFO argument order reversed!
MFOV (intFormat width) reg_c
]
- addSubCOp _ _ _ _ _
+ addSubCOp _ _ _ _
= panic "genCall: Wrong number of arguments/results for addC"
- fabs platform [res] [arg]
- = do let res_r = getRegisterReg platform (CmmLocal res)
+ fabs [res] [arg]
+ = do let res_r = getLocalRegReg res
(arg_reg, arg_code) <- getSomeReg arg
return $ arg_code `snocOL` FABS res_r arg_reg
- fabs _ _ _
+ fabs _ _
= panic "genCall: Wrong number of arguments/results for fabs"
-- TODO: replace 'Int' by an enum such as 'PPC_64ABI'
@@ -1817,8 +1794,7 @@ genCCall' config gcp target dest_regs args
accumCode accumUsed | isWord64 arg_ty
&& target32Bit (ncgPlatform config) =
do
- ChildCode64 code vr_lo <- iselExpr64 arg
- let vr_hi = getHiVRegFromLo vr_lo
+ RegCode64 code vr_hi vr_lo <- iselExpr64 arg
case gcp of
GCPAIX ->
@@ -1978,7 +1954,7 @@ genCCall' config gcp target dest_regs args
MR r_dest r4]
| otherwise -> unitOL (MR r_dest r3)
where rep = cmmRegType platform (CmmLocal dest)
- r_dest = getRegisterReg platform (CmmLocal dest)
+ r_dest = getLocalRegReg dest
_ -> panic "genCCall' moveResult: Bad dest_regs"
outOfLineMachOp mop =
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index 2025aa58d7..74c16383f0 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -47,7 +47,8 @@ import GHC.Cmm.DebugBlock
import GHC.CmmToAsm.PIC
import GHC.CmmToAsm.Monad
( NatM, getNewRegNat, getNewLabelNat, setDeltaNat
- , getDeltaNat, getBlockIdNat, getPicBaseNat, getNewRegPairNat
+ , getDeltaNat, getBlockIdNat, getPicBaseNat
+ , Reg64(..), RegCode64(..), getNewReg64, localReg64
, getPicBaseMaybeNat, getDebugBlock, getFileId
, addImmediateSuccessorNat, updateCfgNat, getConfig, getPlatform
, getCfgWeights
@@ -375,19 +376,6 @@ data CondCode
= CondCode Bool Cond InstrBlock
--- | a.k.a "Register64"
--- Reg is the lower 32-bit temporary which contains the result.
--- Use getHiVRegFromLo to find the other VRegUnique.
---
--- Rules of this simplified insn selection game are therefore that
--- the returned Reg may be modified
---
-data ChildCode64
- = ChildCode64
- InstrBlock
- Reg
-
-
-- | Register's passed up the tree. If the stix code forces the register
-- to live in a pre-decided machine register, it comes out as @Fixed@;
-- otherwise, it comes out as @Any@, and the parent can decide which
@@ -402,14 +390,15 @@ swizzleRegisterRep :: Register -> Format -> Register
swizzleRegisterRep (Fixed _ reg code) format = Fixed format reg code
swizzleRegisterRep (Any _ codefn) format = Any format codefn
+getLocalRegReg :: LocalReg -> Reg
+getLocalRegReg (LocalReg u pk)
+ = -- by Assuming SSE2, Int,Word,Float,Double all can be register allocated
+ RegVirtual (mkVirtualReg u (cmmTypeFormat pk))
-- | Grab the Reg for a CmmReg
getRegisterReg :: Platform -> CmmReg -> Reg
-getRegisterReg _ (CmmLocal (LocalReg u pk))
- = -- by Assuming SSE2, Int,Word,Float,Double all can be register allocated
- let fmt = cmmTypeFormat pk in
- RegVirtual (mkVirtualReg u fmt)
+getRegisterReg _ (CmmLocal lreg) = getLocalRegReg lreg
getRegisterReg platform (CmmGlobal mid)
= case globalRegMaybe platform mid of
@@ -487,10 +476,8 @@ getSomeReg expr = do
assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_I64Code addrTree valueTree = do
Amode addr addr_code <- getAmode addrTree
- ChildCode64 vcode rlo <- iselExpr64 valueTree
+ RegCode64 vcode rhi rlo <- iselExpr64 valueTree
let
- rhi = getHiVRegFromLo rlo
-
-- Little-endian store
mov_lo = MOV II32 (OpReg rlo) (OpAddr addr)
mov_hi = MOV II32 (OpReg rhi) (OpAddr (fromJust (addrOffset addr 4)))
@@ -498,12 +485,10 @@ assignMem_I64Code addrTree valueTree = do
assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock
-assignReg_I64Code (CmmLocal (LocalReg u_dst _)) valueTree = do
- ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
+assignReg_I64Code (CmmLocal dst) valueTree = do
+ RegCode64 vcode r_src_hi r_src_lo <- iselExpr64 valueTree
let
- r_dst_lo = RegVirtual $ mkVirtualReg u_dst II32
- r_dst_hi = getHiVRegFromLo r_dst_lo
- r_src_hi = getHiVRegFromLo r_src_lo
+ Reg64 r_dst_hi r_dst_lo = localReg64 dst
mov_lo = MOV II32 (OpReg r_src_lo) (OpReg r_dst_lo)
mov_hi = MOV II32 (OpReg r_src_hi) (OpReg r_dst_hi)
return (
@@ -514,9 +499,9 @@ assignReg_I64Code _ _
= panic "assignReg_I64Code(i386): invalid lvalue"
-iselExpr64 :: CmmExpr -> NatM ChildCode64
+iselExpr64 :: HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 (CmmLit (CmmInt i _)) = do
- (rlo,rhi) <- getNewRegPairNat II32
+ Reg64 rhi rlo <- getNewReg64
let
r = fromIntegral (fromIntegral i :: Word32)
q = fromIntegral (fromIntegral (i `shiftR` 32) :: Word32)
@@ -524,91 +509,80 @@ iselExpr64 (CmmLit (CmmInt i _)) = do
MOV II32 (OpImm (ImmInteger r)) (OpReg rlo),
MOV II32 (OpImm (ImmInteger q)) (OpReg rhi)
]
- return (ChildCode64 code rlo)
+ return (RegCode64 code rhi rlo)
iselExpr64 (CmmLoad addrTree ty _) | isWord64 ty = do
Amode addr addr_code <- getAmode addrTree
- (rlo,rhi) <- getNewRegPairNat II32
+ Reg64 rhi rlo <- getNewReg64
let
mov_lo = MOV II32 (OpAddr addr) (OpReg rlo)
mov_hi = MOV II32 (OpAddr (fromJust (addrOffset addr 4))) (OpReg rhi)
return (
- ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
- rlo
+ RegCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi) rhi rlo
)
-iselExpr64 (CmmReg (CmmLocal (LocalReg vu ty))) | isWord64 ty
- = return (ChildCode64 nilOL (RegVirtual $ mkVirtualReg vu II32))
+iselExpr64 (CmmReg (CmmLocal local_reg)) = do
+ let Reg64 hi lo = localReg64 local_reg
+ return (RegCode64 nilOL hi lo)
-- we handle addition, but rather badly
iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)]) = do
- ChildCode64 code1 r1lo <- iselExpr64 e1
- (rlo,rhi) <- getNewRegPairNat II32
+ RegCode64 code1 r1hi r1lo <- iselExpr64 e1
+ Reg64 rhi rlo <- getNewReg64
let
r = fromIntegral (fromIntegral i :: Word32)
q = fromIntegral (fromIntegral (i `shiftR` 32) :: Word32)
- r1hi = getHiVRegFromLo r1lo
code = code1 `appOL`
toOL [ MOV II32 (OpReg r1lo) (OpReg rlo),
ADD II32 (OpImm (ImmInteger r)) (OpReg rlo),
MOV II32 (OpReg r1hi) (OpReg rhi),
ADC II32 (OpImm (ImmInteger q)) (OpReg rhi) ]
- return (ChildCode64 code rlo)
+ return (RegCode64 code rhi rlo)
iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
- ChildCode64 code1 r1lo <- iselExpr64 e1
- ChildCode64 code2 r2lo <- iselExpr64 e2
- (rlo,rhi) <- getNewRegPairNat II32
+ RegCode64 code1 r1hi r1lo <- iselExpr64 e1
+ RegCode64 code2 r2hi r2lo <- iselExpr64 e2
+ Reg64 rhi rlo <- getNewReg64
let
- r1hi = getHiVRegFromLo r1lo
- r2hi = getHiVRegFromLo r2lo
code = code1 `appOL`
code2 `appOL`
toOL [ MOV II32 (OpReg r1lo) (OpReg rlo),
ADD II32 (OpReg r2lo) (OpReg rlo),
MOV II32 (OpReg r1hi) (OpReg rhi),
ADC II32 (OpReg r2hi) (OpReg rhi) ]
- return (ChildCode64 code rlo)
+ return (RegCode64 code rhi rlo)
iselExpr64 (CmmMachOp (MO_Sub _) [e1,e2]) = do
- ChildCode64 code1 r1lo <- iselExpr64 e1
- ChildCode64 code2 r2lo <- iselExpr64 e2
- (rlo,rhi) <- getNewRegPairNat II32
+ RegCode64 code1 r1hi r1lo <- iselExpr64 e1
+ RegCode64 code2 r2hi r2lo <- iselExpr64 e2
+ Reg64 rhi rlo <- getNewReg64
let
- r1hi = getHiVRegFromLo r1lo
- r2hi = getHiVRegFromLo r2lo
code = code1 `appOL`
code2 `appOL`
toOL [ MOV II32 (OpReg r1lo) (OpReg rlo),
SUB II32 (OpReg r2lo) (OpReg rlo),
MOV II32 (OpReg r1hi) (OpReg rhi),
SBB II32 (OpReg r2hi) (OpReg rhi) ]
- return (ChildCode64 code rlo)
+ return (RegCode64 code rhi rlo)
iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr]) = do
- fn <- getAnyReg expr
- r_dst_lo <- getNewRegNat II32
- let r_dst_hi = getHiVRegFromLo r_dst_lo
- code = fn r_dst_lo
- return (
- ChildCode64 (code `snocOL`
+ code <- getAnyReg expr
+ Reg64 r_dst_hi r_dst_lo <- getNewReg64
+ return $ RegCode64 (code r_dst_lo `snocOL`
MOV II32 (OpImm (ImmInt 0)) (OpReg r_dst_hi))
+ r_dst_hi
r_dst_lo
- )
iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do
- fn <- getAnyReg expr
- r_dst_lo <- getNewRegNat II32
- let r_dst_hi = getHiVRegFromLo r_dst_lo
- code = fn r_dst_lo
- return (
- ChildCode64 (code `snocOL`
+ code <- getAnyReg expr
+ Reg64 r_dst_hi r_dst_lo <- getNewReg64
+ return $ RegCode64 (code r_dst_lo `snocOL`
MOV II32 (OpReg r_dst_lo) (OpReg eax) `snocOL`
CLTD II32 `snocOL`
MOV II32 (OpReg eax) (OpReg r_dst_lo) `snocOL`
MOV II32 (OpReg edx) (OpReg r_dst_hi))
+ r_dst_hi
r_dst_lo
- )
iselExpr64 expr
= do
@@ -657,23 +631,23 @@ getRegister' platform is32Bit (CmmMachOp (MO_AlignmentCheck align _) [e])
getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W32)
[CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]])
| is32Bit = do
- ChildCode64 code rlo <- iselExpr64 x
- return $ Fixed II32 (getHiVRegFromLo rlo) code
+ RegCode64 code rhi _rlo <- iselExpr64 x
+ return $ Fixed II32 rhi code
getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W64 W32)
[CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]])
| is32Bit = do
- ChildCode64 code rlo <- iselExpr64 x
- return $ Fixed II32 (getHiVRegFromLo rlo) code
+ RegCode64 code rhi _rlo <- iselExpr64 x
+ return $ Fixed II32 rhi code
getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W32) [x])
| is32Bit = do
- ChildCode64 code rlo <- iselExpr64 x
+ RegCode64 code _rhi rlo <- iselExpr64 x
return $ Fixed II32 rlo code
getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W64 W32) [x])
| is32Bit = do
- ChildCode64 code rlo <- iselExpr64 x
+ RegCode64 code _rhi rlo <- iselExpr64 x
return $ Fixed II32 rlo code
getRegister' _ _ (CmmLit lit@(CmmFloat f w)) =
@@ -1876,22 +1850,19 @@ genCondBranch' :: Bool -> BlockId -> BlockId -> BlockId -> CmmExpr
genCondBranch' is32Bit _bid true false (CmmMachOp mop [e1,e2])
| is32Bit, Just W64 <- maybeIntComparison mop = do
- -- The resulting registers here are both the lower part of
- -- the register as well as a way to get at the higher part.
- ChildCode64 code1 r1 <- iselExpr64 e1
- ChildCode64 code2 r2 <- iselExpr64 e2
+ RegCode64 code1 r1hi r1lo <- iselExpr64 e1
+ RegCode64 code2 r2hi r2lo <- iselExpr64 e2
let cond = machOpToCond mop :: Cond
-- we mustn't clobber r1/r2 so we use temporaries
tmp1 <- getNewRegNat II32
tmp2 <- getNewRegNat II32
- let cmpCode = intComparison cond true false r1 r2 tmp1 tmp2
+ let cmpCode = intComparison cond true false r1hi r1lo r2hi r2lo tmp1 tmp2
return $ code1 `appOL` code2 `appOL` cmpCode
where
- intComparison :: Cond -> BlockId -> BlockId -> Reg -> Reg -> Reg -> Reg -> InstrBlock
- intComparison cond true false r1_lo r2_lo tmp1 tmp2 =
+ intComparison cond true false r1_hi r1_lo r2_hi r2_lo tmp1 tmp2 =
case cond of
-- Impossible results of machOpToCond
ALWAYS -> panic "impossible"
@@ -1908,17 +1879,15 @@ genCondBranch' is32Bit _bid true false (CmmMachOp mop [e1,e2])
GE -> cmpGE
GEU -> cmpGE
-- [x > y] <==> ![y >= x]
- GTT -> intComparison GE false true r2_lo r1_lo tmp1 tmp2
- GU -> intComparison GEU false true r2_lo r1_lo tmp1 tmp2
+ GTT -> intComparison GE false true r2_hi r2_lo r1_hi r1_lo tmp1 tmp2
+ GU -> intComparison GEU false true r2_hi r2_lo r1_hi r1_lo tmp1 tmp2
-- [x <= y] <==> [y >= x]
- LE -> intComparison GE true false r2_lo r1_lo tmp1 tmp2
- LEU -> intComparison GEU true false r2_lo r1_lo tmp1 tmp2
+ LE -> intComparison GE true false r2_hi r2_lo r1_hi r1_lo tmp1 tmp2
+ LEU -> intComparison GEU true false r2_hi r2_lo r1_hi r1_lo tmp1 tmp2
-- [x < y] <==> ![x >= x]
- LTT -> intComparison GE false true r1_lo r2_lo tmp1 tmp2
- LU -> intComparison GEU false true r1_lo r2_lo tmp1 tmp2
+ LTT -> intComparison GE false true r1_hi r1_lo r2_hi r2_lo tmp1 tmp2
+ LU -> intComparison GEU false true r1_hi r1_lo r2_hi r2_lo tmp1 tmp2
where
- r1_hi = getHiVRegFromLo r1_lo
- r2_hi = getHiVRegFromLo r2_lo
cmpExact :: OrdList Instr
cmpExact =
toOL
@@ -2407,10 +2376,9 @@ genCCall32 addr conv dest_regs args = do
push_arg arg -- we don't need the hints on x86
| isWord64 arg_ty = do
- ChildCode64 code r_lo <- iselExpr64 arg
+ RegCode64 code r_hi r_lo <- iselExpr64 arg
delta <- getDeltaNat
setDeltaNat (delta - 8)
- let r_hi = getHiVRegFromLo r_lo
return ( code `appOL`
toOL [PUSH II32 (OpReg r_hi), DELTA (delta - 4),
PUSH II32 (OpReg r_lo), DELTA (delta - 8),
@@ -2536,7 +2504,7 @@ genCCall32 addr conv dest_regs args = do
w = typeWidth ty
b = widthInBytes w
r_dest_hi = getHiVRegFromLo r_dest
- r_dest = getRegisterReg platform (CmmLocal dest)
+ r_dest = getLocalRegReg dest
assign_code many = pprPanic "genForeignCall.assign_code - too many return values:" (ppr many)
return (push_code `appOL`
@@ -3388,10 +3356,8 @@ genCtz64_32
-> CmmExpr
-> NatM (InstrBlock, Maybe BlockId)
genCtz64_32 bid dst src = do
- ChildCode64 vcode rlo <- iselExpr64 src
- platform <- ncgPlatform <$> getConfig
- let rhi = getHiVRegFromLo rlo
- dst_r = getRegisterReg platform (CmmLocal dst)
+ RegCode64 vcode rhi rlo <- iselExpr64 src
+ let dst_r = getLocalRegReg dst
lbl1 <- getBlockIdNat
lbl2 <- getBlockIdNat
tmp_r <- getNewRegNat II64
@@ -3438,8 +3404,7 @@ genCtzGeneric width dst src = do
code_src <- getAnyReg src
config <- getConfig
let bw = widthInBits width
- let platform = ncgPlatform config
- let dst_r = getRegisterReg platform (CmmLocal dst)
+ let dst_r = getLocalRegReg dst
if ncgBmiVersion config >= Just BMI2
then do
src_r <- getNewRegNat (intFormat width)
@@ -3709,26 +3674,27 @@ genPrefetchData n src = do
genByteSwap :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genByteSwap width dst src = do
- platform <- ncgPlatform <$> getConfig
is32Bit <- is32BitPlatform
- let dst_r = getRegisterReg platform (CmmLocal dst)
let format = intFormat width
case width of
W64 | is32Bit -> do
- ChildCode64 vcode rlo <- iselExpr64 src
- let dst_rhi = getHiVRegFromLo dst_r
- rhi = getHiVRegFromLo rlo
- return $ vcode `appOL`
- toOL [ MOV II32 (OpReg rlo) (OpReg dst_rhi),
- MOV II32 (OpReg rhi) (OpReg dst_r),
- BSWAP II32 dst_rhi,
- BSWAP II32 dst_r ]
- W16 -> do code_src <- getAnyReg src
- return $ code_src dst_r `appOL`
- unitOL (BSWAP II32 dst_r) `appOL`
- unitOL (SHR II32 (OpImm $ ImmInt 16) (OpReg dst_r))
- _ -> do code_src <- getAnyReg src
- return $ code_src dst_r `appOL` unitOL (BSWAP format dst_r)
+ let Reg64 dst_hi dst_lo = localReg64 dst
+ RegCode64 vcode rhi rlo <- iselExpr64 src
+ return $ vcode `appOL`
+ toOL [ MOV II32 (OpReg rlo) (OpReg dst_hi),
+ MOV II32 (OpReg rhi) (OpReg dst_lo),
+ BSWAP II32 dst_hi,
+ BSWAP II32 dst_lo ]
+ W16 -> do
+ let dst_r = getLocalRegReg dst
+ code_src <- getAnyReg src
+ return $ code_src dst_r `appOL`
+ unitOL (BSWAP II32 dst_r) `appOL`
+ unitOL (SHR II32 (OpImm $ ImmInt 16) (OpReg dst_r))
+ _ -> do
+ let dst_r = getLocalRegReg dst
+ code_src <- getAnyReg src
+ return $ code_src dst_r `appOL` unitOL (BSWAP format dst_r)
genBitRev :: BlockId -> Width -> CmmFormal -> CmmActual -> NatM InstrBlock
genBitRev bid width dst src = do
@@ -3806,8 +3772,7 @@ genPext bid width dst src mask = do
if ncgBmiVersion config >= Just BMI2
then do
let format = intFormat width
- let platform = ncgPlatform config
- let dst_r = getRegisterReg platform (CmmLocal dst)
+ let dst_r = getLocalRegReg dst
code_src <- getAnyReg src
code_mask <- getAnyReg mask
src_r <- getNewRegNat format
@@ -3839,9 +3804,8 @@ genClz bid width dst src = do
genPrimCCall bid (clzLabel width) [dst] [src]
else do
- let platform = ncgPlatform config
code_src <- getAnyReg src
- let dst_r = getRegisterReg platform (CmmLocal dst)
+ let dst_r = getLocalRegReg dst
if ncgBmiVersion config >= Just BMI2
then do
src_r <- getNewRegNat (intFormat width)
@@ -3879,8 +3843,7 @@ genWordToFloat bid width dst src =
genAtomicRead :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genAtomicRead width dst addr = do
load_code <- intLoadCode (MOV (intFormat width)) addr
- platform <- ncgPlatform <$> getConfig
- return (load_code (getRegisterReg platform (CmmLocal dst)))
+ return (load_code (getLocalRegReg dst))
genAtomicWrite :: Width -> CmmExpr -> CmmExpr -> NatM InstrBlock
genAtomicWrite width addr val = do
@@ -3931,10 +3894,8 @@ genXchg width dst addr value = do
Amode amode addr_code <- getSimpleAmode addr
(newval, newval_code) <- getSomeReg value
- config <- getConfig
let format = intFormat width
- let platform = ncgPlatform config
- let dst_r = getRegisterReg platform (CmmLocal dst)
+ let dst_r = getLocalRegReg dst
-- Copy the value into the target register, perform the exchange.
let code = toOL
[ MOV format (OpReg newval) (OpReg dst_r)
@@ -3947,9 +3908,7 @@ genXchg width dst addr value = do
genFloatAbs :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genFloatAbs width dst src = do
- config <- getConfig
let
- platform = ncgPlatform config
format = floatFormat width
const = case width of
W32 -> CmmInt 0x7fffffff W32
@@ -3958,7 +3917,7 @@ genFloatAbs width dst src = do
src_code <- getAnyReg src
Amode amode amode_code <- memConstant (mkAlignment $ widthInBytes width) const
tmp <- getNewRegNat format
- let dst_r = getRegisterReg platform (CmmLocal dst)
+ let dst_r = getLocalRegReg dst
pure $ src_code dst_r `appOL` amode_code `appOL` toOL
[ MOV format (OpAddr amode) (OpReg tmp)
, AND format (OpReg tmp) (OpReg dst_r)
@@ -3967,8 +3926,7 @@ genFloatAbs width dst src = do
genFloatSqrt :: Format -> LocalReg -> CmmExpr -> NatM InstrBlock
genFloatSqrt format dst src = do
- platform <- ncgPlatform <$> getConfig
- let dst_r = getRegisterReg platform (CmmLocal dst)
+ let dst_r = getLocalRegReg dst
src_code <- getAnyReg src
pure $ src_code dst_r `snocOL` SQRT format (OpReg dst_r) dst_r
@@ -4005,13 +3963,12 @@ genAddWithCarry
-> CmmExpr
-> NatM InstrBlock
genAddWithCarry width res_h res_l arg_x arg_y = do
- platform <- ncgPlatform <$> getConfig
hCode <- getAnyReg (CmmLit (CmmInt 0 width))
let format = intFormat width
lCode <- anyReg =<< trivialCode width (ADD_CC format)
(Just (ADD_CC format)) arg_x arg_y
- let reg_l = getRegisterReg platform (CmmLocal res_l)
- reg_h = getRegisterReg platform (CmmLocal res_h)
+ let reg_l = getLocalRegReg res_l
+ reg_h = getLocalRegReg res_h
code = hCode reg_h `appOL`
lCode reg_l `snocOL`
ADC format (OpImm (ImmInteger 0)) (OpReg reg_h)
@@ -4027,14 +3984,13 @@ genSignedLargeMul
-> CmmExpr
-> NatM (OrdList Instr)
genSignedLargeMul width res_c res_h res_l arg_x arg_y = do
- platform <- ncgPlatform <$> getConfig
(y_reg, y_code) <- getRegOrMem arg_y
x_code <- getAnyReg arg_x
reg_tmp <- getNewRegNat II8
let format = intFormat width
- reg_h = getRegisterReg platform (CmmLocal res_h)
- reg_l = getRegisterReg platform (CmmLocal res_l)
- reg_c = getRegisterReg platform (CmmLocal res_c)
+ reg_h = getLocalRegReg res_h
+ reg_l = getLocalRegReg res_l
+ reg_c = getLocalRegReg res_c
code = y_code `appOL`
x_code rax `appOL`
toOL [ IMUL2 format y_reg
@@ -4053,12 +4009,11 @@ genUnsignedLargeMul
-> CmmExpr
-> NatM (OrdList Instr)
genUnsignedLargeMul width res_h res_l arg_x arg_y = do
- platform <- ncgPlatform <$> getConfig
(y_reg, y_code) <- getRegOrMem arg_y
x_code <- getAnyReg arg_x
let format = intFormat width
- reg_h = getRegisterReg platform (CmmLocal res_h)
- reg_l = getRegisterReg platform (CmmLocal res_l)
+ reg_h = getLocalRegReg res_h
+ reg_l = getLocalRegReg res_l
code = y_code `appOL`
x_code rax `appOL`
toOL [MUL2 format y_reg,
@@ -4088,10 +4043,9 @@ genQuotRem width signed res_q res_r m_arg_x_high arg_x_low arg_y = do
genQuotRem W16 signed res_q res_r m_arg_x_high_16 arg_x_low_16 arg_y_16
_ -> do
- platform <- ncgPlatform <$> getConfig
let format = intFormat width
- reg_q = getRegisterReg platform (CmmLocal res_q)
- reg_r = getRegisterReg platform (CmmLocal res_r)
+ reg_q = getLocalRegReg res_q
+ reg_r = getLocalRegReg res_r
widen | signed = CLTD format
| otherwise = XOR format (OpReg rdx) (OpReg rdx)
instr | signed = IDIV