[Git][ghc/ghc][wip/supersven/ghc-master-riscv-ncg] 2 commits: Make instruction types strict in their fields
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Sun Sep 1 17:40:21 UTC 2024
Sven Tennie pushed to branch wip/supersven/ghc-master-riscv-ncg at Glasgow Haskell Compiler / GHC
Commits:
3b4dc97b by Sven Tennie at 2024-09-01T19:29:30+02:00
Make instruction types strict in their fields
This should prevent memory leaks.
- - - - -
26c79cfa by Sven Tennie at 2024-09-01T19:30:53+02:00
Use FCVT constructor for all float-related conversions
This is closer to the assembly instruction and should reduce confusion.
- - - - -
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
=====================================
@@ -723,7 +723,7 @@ getRegister' config plat expr =
( \dst ->
code
`appOL` code_x
- `snocOL` annExpr expr (SCVTF (OpReg to dst) (OpReg from reg_x)) -- (Signed ConVerT Float)
+ `snocOL` annExpr expr (FCVT IntToFloat (OpReg to dst) (OpReg from reg_x)) -- (Signed ConVerT Float)
)
MO_SF_Round from to ->
pure
@@ -731,7 +731,7 @@ getRegister' config plat expr =
(floatFormat to)
( \dst ->
code
- `snocOL` annExpr expr (SCVTF (OpReg to dst) (OpReg from reg)) -- (Signed ConVerT Float)
+ `snocOL` annExpr expr (FCVT IntToFloat (OpReg to dst) (OpReg from reg)) -- (Signed ConVerT Float)
)
-- TODO: Can this case happen?
MO_FS_Truncate from to
@@ -743,7 +743,7 @@ getRegister' config plat expr =
code
`snocOL`
-- W32 is the smallest width to convert to. Decrease width afterwards.
- annExpr expr (FCVTZS (OpReg W32 dst) (OpReg from reg))
+ annExpr expr (FCVT FloatToInt (OpReg W32 dst) (OpReg from reg))
`appOL` signExtendAdjustPrecission W32 to dst dst -- (float convert (-> zero) signed)
)
MO_FS_Truncate from to ->
@@ -752,7 +752,7 @@ getRegister' config plat expr =
(intFormat to)
( \dst ->
code
- `snocOL` annExpr expr (FCVTZS (OpReg to dst) (OpReg from reg))
+ `snocOL` annExpr expr (FCVT FloatToInt (OpReg to dst) (OpReg from reg))
`appOL` truncateReg from to dst -- (float convert (-> zero) signed)
)
MO_UU_Conv from to
@@ -774,7 +774,7 @@ getRegister' config plat expr =
`appOL` truncateReg from to dst
)
MO_SS_Conv from to -> ss_conv from to reg code
- MO_FF_Conv from to -> return $ Any (floatFormat to) (\dst -> code `snocOL` annExpr e (FCVT (OpReg to dst) (OpReg from reg)))
+ MO_FF_Conv from to -> return $ Any (floatFormat to) (\dst -> code `snocOL` annExpr e (FCVT FloatToFloat (OpReg to dst) (OpReg from reg)))
MO_WF_Bitcast w -> return $ Any (floatFormat w) (\dst -> code `snocOL` MOV (OpReg w dst) (OpReg w reg))
MO_FW_Bitcast w -> return $ Any (intFormat w) (\dst -> code `snocOL` MOV (OpReg w dst) (OpReg w reg))
@@ -2205,8 +2205,6 @@ makeFarBranches {- only used when debugging -} _platform statics basic_blocks =
LDRU {} -> 1
FENCE {} -> 1
FCVT {} -> 1
- SCVTF {} -> 1
- FCVTZS {} -> 1
FABS {} -> 1
FMA {} -> 1
-- estimate the subsituted size for jumps to lables
=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -1,3 +1,6 @@
+-- All instructions will be rendered eventually. Thus, there's no benefit in
+-- being lazy in data types.
+{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module GHC.CmmToAsm.RV64.Instr where
@@ -101,9 +104,7 @@ regUsageOfInstr platform instr = case instr of
LDR _ dst src -> usage (regOp src, regOp dst)
LDRU _ dst src -> usage (regOp src, regOp dst)
FENCE _ _ -> usage ([], [])
- FCVT dst src -> usage (regOp src, regOp dst)
- SCVTF dst src -> usage (regOp src, regOp dst)
- FCVTZS dst src -> usage (regOp src, regOp dst)
+ FCVT _variant dst src -> usage (regOp src, regOp dst)
FABS dst src -> usage (regOp src, regOp dst)
FMA _ dst src1 src2 src3 ->
usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst)
@@ -186,9 +187,7 @@ patchRegsOfInstr instr env = case instr of
LDR f o1 o2 -> LDR f (patchOp o1) (patchOp o2)
LDRU f o1 o2 -> LDRU f (patchOp o1) (patchOp o2)
FENCE o1 o2 -> FENCE o1 o2
- FCVT o1 o2 -> FCVT (patchOp o1) (patchOp o2)
- SCVTF o1 o2 -> SCVTF (patchOp o1) (patchOp o2)
- FCVTZS o1 o2 -> FCVTZS (patchOp o1) (patchOp o2)
+ FCVT variant o1 o2 -> FCVT variant (patchOp o1) (patchOp o2)
FABS o1 o2 -> FABS (patchOp o1) (patchOp o2)
FMA s o1 o2 o3 o4 ->
FMA s (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4)
@@ -588,14 +587,8 @@ data Instr
--
-- Memory barrier.
FENCE FenceType FenceType
- | -- | Floating point ConVerT
- FCVT Operand Operand
- | -- | Signed floating point ConVerT
- SCVTF Operand Operand
- | -- TODO: Same as SCVTF?
-
- -- | Floating point ConVerT to Zero Signed
- FCVTZS Operand Operand
+ | -- | Floating point conversion
+ FCVT FcvtVariant Operand Operand
| -- | Floating point ABSolute value
FABS Operand Operand
| -- | Floating-point fused multiply-add instructions
@@ -609,6 +602,9 @@ data Instr
-- | Operand of a FENCE instruction (@r@, @w@ or @rw@)
data FenceType = FenceRead | FenceWrite | FenceReadWrite
+-- | Variant of a floating point conversion instruction
+data FcvtVariant = FloatToFloat | IntToFloat | FloatToInt
+
instrCon :: Instr -> String
instrCon i =
case i of
@@ -649,8 +645,6 @@ instrCon i =
BCOND {} -> "BCOND"
FENCE {} -> "FENCE"
FCVT {} -> "FCVT"
- SCVTF {} -> "SCVTF"
- FCVTZS {} -> "FCVTZS"
FABS {} -> "FABS"
FMA variant _ _ _ _ ->
case variant of
=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -646,23 +646,23 @@ pprInstr platform instr = case instr of
LDRU FF64 o1 o2@(OpAddr (AddrRegImm _ _)) -> op2 (text "\tfld") o1 o2
LDRU f o1 o2 -> pprPanic "Unsupported unsigned load" ((text . show) f <+> pprOp platform o1 <+> pprOp platform o2)
FENCE r w -> line $ text "\tfence" <+> pprFenceType r <> char ',' <+> pprFenceType w
- FCVT o1@(OpReg W32 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.s.d") o1 o2
- FCVT o1@(OpReg W64 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.d.s") o1 o2
- FCVT o1 o2 ->
- pprPanic "RV64.pprInstr - impossible float conversion"
+ FCVT FloatToFloat o1@(OpReg W32 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.s.d") o1 o2
+ FCVT FloatToFloat o1@(OpReg W64 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.d.s") o1 o2
+ FCVT FloatToFloat o1 o2 ->
+ pprPanic "RV64.pprInstr - impossible float to float conversion"
$ line (pprOp platform o1 <> text "->" <> pprOp platform o2)
- SCVTF o1@(OpReg W32 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.s.w") o1 o2
- SCVTF o1@(OpReg W32 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.s.l") o1 o2
- SCVTF o1@(OpReg W64 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.d.w") o1 o2
- SCVTF o1@(OpReg W64 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.d.l") o1 o2
- SCVTF o1 o2 ->
+ FCVT IntToFloat o1@(OpReg W32 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.s.w") o1 o2
+ FCVT IntToFloat o1@(OpReg W32 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.s.l") o1 o2
+ FCVT IntToFloat o1@(OpReg W64 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.d.w") o1 o2
+ FCVT IntToFloat o1@(OpReg W64 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.d.l") o1 o2
+ FCVT IntToFloat o1 o2 ->
pprPanic "RV64.pprInstr - impossible integer to float conversion"
$ line (pprOp platform o1 <> text "->" <> pprOp platform o2)
- FCVTZS o1@(OpReg W32 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.w.s") o1 o2
- FCVTZS o1@(OpReg W32 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.w.d") o1 o2
- FCVTZS o1@(OpReg W64 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.l.s") o1 o2
- FCVTZS o1@(OpReg W64 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.l.d") o1 o2
- FCVTZS o1 o2 ->
+ FCVT FloatToInt o1@(OpReg W32 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.w.s") o1 o2
+ FCVT FloatToInt o1@(OpReg W32 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.w.d") o1 o2
+ FCVT FloatToInt o1@(OpReg W64 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.l.s") o1 o2
+ FCVT FloatToInt o1@(OpReg W64 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.l.d") o1 o2
+ FCVT FloatToInt o1 o2 ->
pprPanic "RV64.pprInstr - impossible float to integer conversion"
$ line (pprOp platform o1 <> text "->" <> pprOp platform o2)
FABS o1 o2 | isSingleOp o2 -> op2 (text "\tfabs.s") o1 o2
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a38bf4541dc3a2888da1f03bffe906ff5ff5ac63...26c79cfa3cee3cf0651f91b7b75d00268e985e91
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a38bf4541dc3a2888da1f03bffe906ff5ff5ac63...26c79cfa3cee3cf0651f91b7b75d00268e985e91
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/20240901/3fee31da/attachment-0001.html>
More information about the ghc-commits
mailing list