[Git][ghc/ghc][wip/andreask/arm_immediates] WIP: Better arm immediate handling
Andreas Klebinger (@AndreasK)
gitlab at gitlab.haskell.org
Fri Jul 7 17:07:39 UTC 2023
Andreas Klebinger pushed to branch wip/andreask/arm_immediates at Glasgow Haskell Compiler / GHC
Commits:
b32102e3 by Andreas Klebinger at 2023-07-07T19:09:35+02:00
WIP: Better arm immediate handling
wip
wip
wip
w
- - - - -
3 changed files:
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/X86/Regs.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
=====================================
@@ -372,6 +372,70 @@ getSomeReg expr = do
Fixed rep reg code ->
return (reg, rep, code)
+-- | Move (wide immediate)
+-- Allows for 16bit immediate which can be shifted by 0/16/32/48 bits.
+-- Covers MOVZ,MOVN, MOVK
+getMovWideImm :: Integer -> Maybe Operand
+getMovWideImm n
+ -- TODO: Handle sign extension
+ | n <= 0
+ = Nothing
+ -- Fits in 16 bits
+ | sized_n < 2^(16 :: Int)
+ = Just $ OpImm (ImmInteger n)
+
+ -- 0x0000 0000 xxxx 0000
+ | trailing_zeros >= 16 && sized_n < 2^(32 :: Int)
+ = Just $ OpImmShift (ImmInteger $ n `shiftR` 16) SLSL 16
+
+ -- 0x 0000 xxxx 0000 0000
+ | trailing_zeros >= 32 && sized_n < 2^(48 :: Int)
+ = Just $ OpImmShift (ImmInteger $ n `shiftR` 32) SLSL 32
+
+ -- 0x xxxx 0000 0000 0000
+ | trailing_zeros >= 48
+ = Just $ OpImmShift (ImmInteger $ n `shiftR` 48) SLSL 48
+
+ | otherwise
+ = Nothing
+ where
+ sized_n = fromIntegral n :: Word64
+ trailing_zeros = countTrailingZeros sized_n
+-- getMovWideImm _ = Nothing
+
+-- | Arithmetic(immediate)
+-- Allows for 12bit immediates which can be shifted by 0 or 12 bits.
+-- Covers ADD, ADDS, SUB, SUBS, CMP, CMN
+getArithImm :: Integer -> Maybe Operand
+getArithImm n
+ -- TODO: Handle sign extension
+ | n <= 0
+ = Nothing
+ -- Fits in 16 bits
+ -- Fits in 12 bits
+ | sized_n < 2^(12::Int)
+ = Just $ OpImm (ImmInteger n)
+
+ -- 12 bits shifted by 12 places.
+ | trailing_zeros >= 12 && sized_n < 2^(24::Int)
+ = Just $ OpImmShift (ImmInteger $ n `shiftR` 12) SLSL 12
+
+ | otherwise
+ = Nothing
+ where
+ sized_n = fromIntegral n :: Word64
+ trailing_zeros = countTrailingZeros sized_n
+
+-- | Logical (immediate)
+-- Allows for Note [Logical immediate instruction variant]
+-- Covers AND, ANDS, EOR, ORR, TST
+-- and their aliases which includes at least MOV (bitmask immediate)
+getBitmaskImm :: Integer -> Maybe Operand
+getBitmaskImm n
+ | isAArch64Bitmask n = Just $ OpImm (ImmInteger n)
+ | otherwise = Nothing
+
+
-- TODO OPT: we might be able give getRegister
-- a hint, what kind of register we want.
getFloatReg :: HasCallStack => CmmExpr -> NatM (Reg, Format, InstrBlock)
@@ -494,8 +558,13 @@ getRegister' config plat expr
CmmLit lit
-> case lit of
- -- TODO handle CmmInt 0 specially, use wzr or xzr.
-
+ -- Use wzr xzr for CmmInt 0 if the width matches up, otherwise do a move.
+ CmmInt 0 W32 -> do
+ let format = intFormat W32
+ return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) ))
+ CmmInt 0 W64 -> do
+ let format = intFormat W64
+ return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) ))
CmmInt i W8 | i >= 0 -> do
return (Any (intFormat W8) (\dst -> unitOL $ annExpr expr (MOV (OpReg W8 dst) (OpImm (ImmInteger (narrowU W8 i))))))
CmmInt i W16 | i >= 0 -> do
@@ -791,17 +860,51 @@ getRegister' config plat expr
-- withTempFloatReg w op = OpReg w <$> getNewRegNat (floatFormat w) >>= op
-- A "plain" operation.
- bitOp w op = do
+ bitOpImm w op encode_imm = do
-- compute x<m> <- x
-- compute x<o> <- y
-- <OP> x<n>, x<m>, x<o>
(reg_x, format_x, code_x) <- getSomeReg x
- (reg_y, format_y, code_y) <- getSomeReg y
- massertPpr (isIntFormat format_x == isIntFormat format_y) $ text "bitOp: incompatible"
+ (op_y, format_y, code_y) <- case y of
+ CmmLit (CmmInt n w)
+ | Just imm_operand_y <- encode_imm n
+ -> return (imm_operand_y, intFormat w, nilOL)
+ _ -> do
+ (reg_y, format_y, code_y) <- getSomeReg y
+ return (OpReg w reg_y, format_y, code_y)
+ massertPpr (isIntFormat format_x == isIntFormat format_y) $ text "bitOpImm: incompatible"
return $ Any (intFormat w) (\dst ->
code_x `appOL`
code_y `appOL`
- op (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))
+ op (OpReg w dst) (OpReg w reg_x) op_y)
+
+ -- A (potentially signed) integer operation.
+ -- In the case of 8- and 16-bit signed arithmetic we must first
+ -- sign-extend both arguments to 32-bits.
+ -- See Note [Signed arithmetic on AArch64].
+ intOpImm :: Bool -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Maybe Operand) -> NatM (Register)
+ intOpImm {- is signed -} True w op _encode_imm = intOp True w op
+ intOpImm False w op encode_imm = do
+ -- compute x<m> <- x
+ -- compute x<o> <- y
+ -- <OP> x<n>, x<m>, x<o>
+ (reg_x, format_x, code_x) <- getSomeReg x
+ (op_y, format_y, code_y) <- case y of
+ CmmLit (CmmInt n w)
+ | Just imm_operand_y <- encode_imm n
+ -> return (imm_operand_y, intFormat w, nilOL)
+ _ -> do
+ (reg_y, format_y, code_y) <- getSomeReg y
+ return (OpReg w reg_y, format_y, code_y)
+ massertPpr (isIntFormat format_x && isIntFormat format_y) $ text "intOp: non-int"
+ -- This is the width of the registers on which the operation
+ -- should be performed.
+ let w' = opRegWidth w
+ return $ Any (intFormat w) $ \dst ->
+ code_x `appOL`
+ code_y `appOL`
+ op (OpReg w' dst) (OpReg w' reg_x) (op_y) `appOL`
+ truncateReg w' w dst -- truncate back to the operand's original width
-- A (potentially signed) integer operation.
-- In the case of 8- and 16-bit signed arithmetic we must first
@@ -847,9 +950,9 @@ getRegister' config plat expr
case op of
-- Integer operations
-- Add/Sub should only be Integer Options.
- MO_Add w -> intOp False w (\d x y -> unitOL $ annExpr expr (ADD d x y))
+ MO_Add w -> intOpImm False w (\d x y -> unitOL $ annExpr expr (ADD d x y)) getArithImm
-- TODO: Handle sub-word case
- MO_Sub w -> intOp False w (\d x y -> unitOL $ annExpr expr (SUB d x y))
+ MO_Sub w -> intOpImm False w (\d x y -> unitOL $ annExpr expr (SUB d x y)) getArithImm
-- Note [CSET]
-- ~~~~~~~~~~~
@@ -891,8 +994,8 @@ getRegister' config plat expr
-- N.B. We needn't sign-extend sub-word size (in)equality comparisons
-- since we don't care about ordering.
- MO_Eq w -> bitOp w (\d x y -> toOL [ CMP x y, CSET d EQ ])
- MO_Ne w -> bitOp w (\d x y -> toOL [ CMP x y, CSET d NE ])
+ MO_Eq w -> bitOpImm w (\d x y -> toOL [ CMP x y, CSET d EQ ]) getArithImm
+ MO_Ne w -> bitOpImm w (\d x y -> toOL [ CMP x y, CSET d NE ]) getArithImm
-- Signed multiply/divide
MO_Mul w -> intOp True w (\d x y -> unitOL $ MUL d x y)
@@ -921,10 +1024,10 @@ getRegister' config plat expr
MO_S_Lt w -> intOp True w (\d x y -> toOL [ CMP x y, CSET d SLT ])
-- Unsigned comparisons
- MO_U_Ge w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d UGE ])
- MO_U_Le w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d ULE ])
- MO_U_Gt w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d UGT ])
- MO_U_Lt w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d ULT ])
+ MO_U_Ge w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d UGE ]) getArithImm
+ MO_U_Le w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d ULE ]) getArithImm
+ MO_U_Gt w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d UGT ]) getArithImm
+ MO_U_Lt w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d ULT ]) getArithImm
-- Floating point arithmetic
MO_F_Add w -> floatOp w (\d x y -> unitOL $ ADD d x y)
@@ -947,9 +1050,9 @@ getRegister' config plat expr
MO_F_Lt w -> floatCond w (\d x y -> toOL [ CMP x y, CSET d OLT ]) -- x < y <=> y >= x
-- Bitwise operations
- MO_And w -> bitOp w (\d x y -> unitOL $ AND d x y)
- MO_Or w -> bitOp w (\d x y -> unitOL $ ORR d x y)
- MO_Xor w -> bitOp w (\d x y -> unitOL $ EOR d x y)
+ MO_And w -> bitOpImm w (\d x y -> unitOL $ AND d x y) getBitmaskImm
+ MO_Or w -> bitOpImm w (\d x y -> unitOL $ ORR d x y) getBitmaskImm
+ MO_Xor w -> bitOpImm w (\d x y -> unitOL $ EOR d x y) getBitmaskImm
MO_Shl w -> intOp False w (\d x y -> unitOL $ LSL d x y)
MO_U_Shr w -> intOp False w (\d x y -> unitOL $ LSR d x y)
MO_S_Shr w -> intOp True w (\d x y -> unitOL $ ASR d x y)
@@ -999,7 +1102,7 @@ getRegister' config plat expr
where
isNbitEncodeable :: Int -> Integer -> Bool
- isNbitEncodeable n i = let shift = n - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift)
+ isNbitEncodeable n_bits i = let shift = n_bits - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift)
-- N.B. MUL does not set the overflow flag.
do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -782,6 +782,9 @@ wzr = OpReg W32 (RegReal (RealRegSingle (-1)))
sp = OpReg W64 (RegReal (RealRegSingle 31))
ip0 = OpReg W64 (RegReal (RealRegSingle 16))
+reg_zero :: Reg
+reg_zero = RegReal (RealRegSingle (-1))
+
_x :: Int -> Operand
_x i = OpReg W64 (RegReal (RealRegSingle i))
x0, x1, x2, x3, x4, x5, x6, x7 :: Operand
=====================================
compiler/GHC/CmmToAsm/X86/Regs.hs
=====================================
@@ -275,6 +275,11 @@ The fp registers are all Double registers; we don't have any RcFloat class
regs. @regClass@ barfs if you give it a VirtualRegF, and mkVReg above should
never generate them.
+esp, esi, edi and ebp are reserved for specific purporses o *generally* free to use because they are
+reserved for reserved for
+
+eax ebx ecx edx
+
TODO: cleanup modelling float vs double registers and how they are the same class.
-}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b32102e3f502c78a66f84e1c4041c1511183b384
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b32102e3f502c78a66f84e1c4041c1511183b384
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230707/eca2b6fc/attachment-0001.html>
More information about the ghc-commits
mailing list