diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2022-02-18 12:42:23 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-02-23 13:59:23 -0500 |
commit | 6fa7591e832d71ebea452ee6ddf97ac513404576 (patch) | |
tree | 7f83a642cb2e3f3be0fac0e69259491b93735f0f /compiler | |
parent | f07b13e38a24d73db152f465922d0fcf903e0470 (diff) | |
download | haskell-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.hs | 50 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/PPC/CodeGen.hs | 220 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/X86/CodeGen.hs | 228 |
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 |