[Git][ghc/ghc][wip/andreask/arm_cleanup] AArch NCG: Pure refactor
Andreas Klebinger (@AndreasK)
gitlab at gitlab.haskell.org
Sat Jul 29 10:51:16 UTC 2023
Andreas Klebinger pushed to branch wip/andreask/arm_cleanup at Glasgow Haskell Compiler / GHC
Commits:
16765cad by Andreas Klebinger at 2023-07-29T12:41:47+02:00
AArch NCG: Pure refactor
Combine some alternatives. Add some line breaks for overly long lines
- - - - -
1 changed file:
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
=====================================
@@ -794,33 +794,25 @@ getRegister' config plat expr
-- 0. TODO This should not exist! Rewrite: Reg +- 0 -> Reg
CmmMachOp (MO_Add _) [expr'@(CmmReg (CmmGlobal _r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr'
CmmMachOp (MO_Sub _) [expr'@(CmmReg (CmmGlobal _r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr'
- -- 1. Compute Reg +/- n directly.
- -- For Add/Sub we can directly encode 12bits, or 12bits lsl #12.
- CmmMachOp (MO_Add w) [(CmmReg reg), CmmLit (CmmInt n _)]
- | n > 0 && n < 4096 -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (ADD (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n))))
- -- TODO: 12bits lsl #12; e.g. lower 12 bits of n are 0; shift n >> 12, and set lsl to #12.
- where w' = formatToWidth (cmmTypeFormat (cmmRegType reg))
- r' = getRegisterReg plat reg
- CmmMachOp (MO_Sub w) [(CmmReg reg), CmmLit (CmmInt n _)]
- | n > 0 && n < 4096 -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (SUB (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n))))
- -- TODO: 12bits lsl #12; e.g. lower 12 bits of n are 0; shift n >> 12, and set lsl to #12.
- where w' = formatToWidth (cmmTypeFormat (cmmRegType reg))
- r' = getRegisterReg plat reg
+ -- Immediates are handled via `getArithImm` in the generic code path.
CmmMachOp (MO_U_Quot w) [x, y] | w == W8 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
(reg_y, _format_y, code_y) <- getSomeReg y
- return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (UXTB (OpReg w reg_y) (OpReg w reg_y)) `snocOL` (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
+ return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL`
+ (UXTB (OpReg w reg_y) (OpReg w reg_y)) `snocOL`
+ (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
CmmMachOp (MO_U_Quot w) [x, y] | w == W16 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
(reg_y, _format_y, code_y) <- getSomeReg y
- return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (UXTH (OpReg w reg_y) (OpReg w reg_y)) `snocOL` (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
+ return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL`
+ (UXTH (OpReg w reg_y) (OpReg w reg_y)) `snocOL`
+ (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
-- 2. Shifts. x << n, x >> n.
- CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do
- (reg_x, _format_x, code_x) <- getSomeReg x
- return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
- CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do
+ CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))]
+ | w == W32 || w == W64
+ , 0 <= n, n < fromIntegral (widthInBits w) -> do
(reg_x, _format_x, code_x) <- getSomeReg x
return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
@@ -830,7 +822,8 @@ getRegister' config plat expr
CmmMachOp (MO_S_Shr w) [x, y] | w == W8 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
(reg_y, _format_y, code_y) <- getSomeReg y
- return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
+ return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL`
+ (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
@@ -838,24 +831,23 @@ getRegister' config plat expr
CmmMachOp (MO_S_Shr w) [x, y] | w == W16 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
(reg_y, _format_y, code_y) <- getSomeReg y
- return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
+ return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL`
+ (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
- CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do
+ CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))]
+ | w == W32 || w == W64
+ , 0 <= n, n < fromIntegral (widthInBits w) -> do
(reg_x, _format_x, code_x) <- getSomeReg x
return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
- CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do
- (reg_x, _format_x, code_x) <- getSomeReg x
- return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
-
-
CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (UBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (8-n)))))
CmmMachOp (MO_U_Shr w) [x, y] | w == W8 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
(reg_y, _format_y, code_y) <- getSomeReg y
- return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
+ return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL`
+ (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
@@ -863,13 +855,12 @@ getRegister' config plat expr
CmmMachOp (MO_U_Shr w) [x, y] | w == W16 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
(reg_y, _format_y, code_y) <- getSomeReg y
- return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
-
- CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do
- (reg_x, _format_x, code_x) <- getSomeReg x
- return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
+ return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x))
+ `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
- CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do
+ CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))]
+ | w == W32 || w == W64
+ , 0 <= n, n < fromIntegral (widthInBits w) -> do
(reg_x, _format_x, code_x) <- getSomeReg x
return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
@@ -915,8 +906,8 @@ getRegister' config plat expr
-- sign-extend both arguments to 32-bits.
-- See Note [Signed arithmetic on AArch64].
intOpImm :: Bool -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Width -> Maybe Operand) -> NatM (Register)
- intOpImm {- is signed -} True w op _encode_imm = intOp True w op
- intOpImm False w op encode_imm = do
+ 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>
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16765cad3b3e5c64bbabf54486da6fb65aec5c69
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16765cad3b3e5c64bbabf54486da6fb65aec5c69
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/20230729/dc5e30ce/attachment-0001.html>
More information about the ghc-commits
mailing list