[Git][ghc/ghc][wip/supersven/riscv64-ncg] Implement MO_S_Shr and truncateReg
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Fri May 19 16:21:39 UTC 2023
Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC
Commits:
c1413de1 by Sven Tennie at 2023-05-19T18:19:28+02:00
Implement MO_S_Shr and truncateReg
These store and load on the stack to move values in changed widths into
registers.
- - - - -
3 changed files:
- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- compiler/GHC/CmmToAsm/RV64/Instr.hs
- compiler/GHC/CmmToAsm/RV64/Ppr.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -707,30 +707,25 @@ getRegister' config plat expr
(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_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do
+ CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | fitsIn12bitImm n -> do
(reg_x, _format_x, code_x) <- getSomeReg x
- return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (8-n)))))
- CmmMachOp (MO_S_Shr w) [x, y] | w == W8 -> do
+ return $ Any (intFormat w) (\dst ->
+ code_x `appOL` toOL [ SUB sp sp (OpImm (ImmInt (widthInBits w)))
+ , STR (intFormat w) (OpReg w reg_x) (OpAddr (AddrRegImm sp_reg (ImmInt 0)))
+ , LDR (intFormat w) (OpReg w reg_x) (OpAddr (AddrRegImm sp_reg (ImmInt 0)))
+ , ADD sp sp (OpImm (ImmInt (widthInBits w)))
+ , ASR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))
+ ])
+ CmmMachOp (MO_S_Shr w) [x, y] -> 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)))
-
- CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do
- (reg_x, _format_x, code_x) <- getSomeReg x
- return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (16-n)))))
- 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)))
-
- CmmMachOp (MO_S_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 (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))))
-
+ return $ Any (intFormat w) (\dst ->
+ code_x `appOL` code_y `appOL` toOL [ SUB sp sp (OpImm (ImmInt (widthInBits w)))
+ , STR (intFormat w) (OpReg w reg_x) (OpAddr (AddrRegImm sp_reg (ImmInt 0)))
+ , LDR (intFormat w) (OpReg w reg_x) (OpAddr (AddrRegImm sp_reg (ImmInt 0)))
+ , ADD sp sp (OpImm (ImmInt (widthInBits w)))
+ , ASR (OpReg w dst) (OpReg w reg_y) (OpImm (ImmInteger 0))
+ ])
CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
@@ -1010,15 +1005,14 @@ signExtendReg w w' r =
-- | Instructions to truncate the value in the given register from width @w@
-- down to width @w'@.
truncateReg :: Width -> Width -> Reg -> OrdList Instr
+truncateReg w _w' _r | w == W64 = nilOL
+truncateReg w w' _r | w == w' = nilOL
truncateReg w w' r =
- case w of
- W64 -> nilOL
- W32
- | w' == W32 -> nilOL
- _ -> unitOL $ UBFM (OpReg w r)
- (OpReg w r)
- (OpImm (ImmInt 0))
- (OpImm $ ImmInt $ widthInBits w' - 1)
+ toOL [ SUB sp sp (OpImm (ImmInt (widthInBits w)))
+ , STR (intFormat w) (OpReg w r) (OpAddr (AddrRegImm sp_reg (ImmInt 0)))
+ , LDR (intFormat w') (OpReg w' r) (OpAddr (AddrRegImm sp_reg (ImmInt 0)))
+ , ADD sp sp (OpImm (ImmInt (widthInBits w)))
+ ]
-- -----------------------------------------------------------------------------
-- The 'Amode' type: Memory addressing modes passed up the tree.
=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -783,6 +783,7 @@ data Operand
| OpRegExt Width Reg ExtMode ExtShift -- rm, <ext>[, <shift left>]
| OpRegShift Width Reg ShiftMode RegShift -- rm, <shift>, <0-64>
| OpImm Imm -- immediate value
+ -- TODO: Does OpImmShift exist in RV64?
| OpImmShift Imm ShiftMode RegShift
| OpAddr AddrMode -- memory reference
deriving (Eq, Show)
=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -498,6 +498,7 @@ pprInstr platform instr = case instr of
AND o1 o2 o3 -> op3 (text "\tand") o1 o2 o3
OR o1 o2 o3 -> op3 (text "\tor") o1 o2 o3
-- ANDS o1 o2 o3 -> op3 (text "\tands") o1 o2 o3
+ ASR o1 o2 o3 | isImmOp o3 -> op3 (text "\tsrai") o1 o2 o3
ASR o1 o2 o3 -> op3 (text "\tsra") o1 o2 o3
BIC o1 o2 o3 -> op3 (text "\tbic") o1 o2 o3
BICS o1 o2 o3 -> op3 (text "\tbics") o1 o2 o3
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1413de14cfda8cd9cbe6197714f77e74c7f60a5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1413de14cfda8cd9cbe6197714f77e74c7f60a5
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/20230519/c90e193e/attachment-0001.html>
More information about the ghc-commits
mailing list