[Git][ghc/ghc][wip/supersven/riscv64-ncg] 10 commits: Remove unused LANGUAGE pragma
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Fri Jan 12 12:09:29 UTC 2024
Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC
Commits:
d9e9bc35 by Sven Tennie at 2024-01-09T06:50:19+01:00
Remove unused LANGUAGE pragma
- - - - -
5a1b1251 by Sven Tennie at 2024-01-09T06:54:02+01:00
Syntax cleanup
- - - - -
05ee8c90 by Sven Tennie at 2024-01-09T06:55:04+01:00
Update comments
- - - - -
fb098ecb by Sven Tennie at 2024-01-09T06:55:54+01:00
Remove unused function: toImm
- - - - -
740d3fe4 by Sven Tennie at 2024-01-09T06:56:15+01:00
Remove unused function: withTempIntReg
- - - - -
346f049d by Sven Tennie at 2024-01-09T06:57:11+01:00
Remove doubled comment
- - - - -
6269ba0d by Sven Tennie at 2024-01-11T19:15:24+01:00
Refactor ss_conv to mute incomplete-pattern-match warning
- - - - -
6854d2f7 by Sven Tennie at 2024-01-11T19:17:35+01:00
Advertise code-gen capability in Hadrian
- - - - -
148e035a by Sven Tennie at 2024-01-11T19:20:33+01:00
Advertise riscv64 interpreter capability (Hadrian)
- - - - -
3e8fa876 by Sven Tennie at 2024-01-12T08:18:01+01:00
Define DWARF regs
- - - - -
5 changed files:
- compiler/GHC/CmmToAsm/Dwarf/Constants.hs
- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- compiler/GHC/CmmToAsm/RV64/Ppr.hs
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Settings/Builders/RunTest.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/Dwarf/Constants.hs
=====================================
@@ -240,6 +240,7 @@ dwarfRegNo p r = case platformArch p of
| r == xmm15 -> 32
ArchPPC_64 _ -> fromIntegral $ toRegNo r
ArchAArch64 -> fromIntegral $ toRegNo r
+ ArchRISCV64 -> fromIntegral $ toRegNo r
_other -> error "dwarfRegNo: Unsupported platform or unknown register!"
-- | Virtual register number to use for return address.
@@ -252,5 +253,6 @@ dwarfReturnRegNo p
ArchX86 -> 8 -- eip
ArchX86_64 -> 16 -- rip
ArchPPC_64 ELF_V2 -> 65 -- lr (link register)
- ArchAArch64-> 30
+ ArchAArch64 -> 30
+ ArchRISCV64 -> 1 -- ra (return address)
_other -> error "dwarfReturnRegNo: Unsupported platform!"
=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -3,7 +3,6 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NumericUnderscores #-}
module GHC.CmmToAsm.RV64.CodeGen (
cmmTopCodeGen
, generateJumpTableForInstr
@@ -538,7 +537,7 @@ getRegister' config plat expr =
(op, imm_code) <- litToImm' lit
let rep = cmmLitType plat lit
format = cmmTypeFormat rep
- return (Any format (\dst -> imm_code `snocOL` (annExpr expr $ LDR format (OpReg (formatToWidth format) dst) op)))
+ return (Any format (\dst -> imm_code `snocOL` annExpr expr (LDR format (OpReg (formatToWidth format) dst) op)))
CmmLabelOff _lbl off | isNbitEncodeable 12 (fromIntegral off) -> do
(op, imm_code) <- litToImm' lit
@@ -554,7 +553,7 @@ getRegister' config plat expr =
(off_r, _off_format, off_code) <- getSomeReg $ CmmLit (CmmInt (fromIntegral off) width)
return (Any format (\dst -> imm_code `appOL` off_code `snocOL` LDR format (OpReg (formatToWidth format) dst) op `snocOL` ADD (OpReg width dst) (OpReg width dst) (OpReg width off_r)))
- CmmLabelDiffOff _ _ _ _ -> pprPanic "getRegister' (CmmLit:CmmLabelOff): " (pdoc plat expr)
+ CmmLabelDiffOff {} -> pprPanic "getRegister' (CmmLit:CmmLabelOff): " (pdoc plat expr)
CmmBlock _ -> pprPanic "getRegister' (CmmLit:CmmLabelOff): " (pdoc plat expr)
CmmHighStackMark -> pprPanic "getRegister' (CmmLit:CmmLabelOff): " (pdoc plat expr)
CmmLoad mem rep _ -> do
@@ -637,16 +636,8 @@ getRegister' config plat expr =
_ -> pprPanic "getRegister' (monadic CmmMachOp):" (pdoc plat expr)
where
- toImm W8 = (OpImm (ImmInt 7))
- toImm W16 = (OpImm (ImmInt 15))
- toImm W32 = (OpImm (ImmInt 31))
- toImm W64 = (OpImm (ImmInt 63))
- toImm W128 = (OpImm (ImmInt 127))
- toImm W256 = (OpImm (ImmInt 255))
- toImm W512 = (OpImm (ImmInt 511))
-
-- In the case of 16- or 8-bit values we need to sign-extend to 32-bits
- -- See Note [Signed arithmetic on AArch64].
+ -- See Note [Signed arithmetic on RISCV64].
negate code w reg = do
let w' = opRegWidth w
(reg', code_sx) <- signExtendReg w w' reg
@@ -656,29 +647,31 @@ getRegister' config plat expr =
NEG (OpReg w' dst) (OpReg w' reg') `appOL`
truncateReg w' w dst
- ss_conv from to reg code | from == to =
- pure $ Any (intFormat from) $ \dst ->
- code `snocOL` (MOV (OpReg from dst) (OpReg from reg))
- ss_conv from to reg code | from < to = do
- pure $ Any (intFormat to) $ \dst ->
- code
- `appOL` signExtend from to reg dst
- `appOL` truncateReg from to dst
- ss_conv from to reg code | from > to =
- pure $ Any (intFormat to) $ \dst ->
- code
- `appOL` toOL
- [ ann
- (text "MO_SS_Conv: narrow register signed" <+> ppr reg <+> ppr from <> text "->" <> ppr to)
- (LSL (OpReg to dst) (OpReg from reg) (OpImm (ImmInt shift))),
- -- signed right shift
- ASR (OpReg to dst) (OpReg to dst) (OpImm (ImmInt shift))
- ]
- `appOL` truncateReg from to dst
- where
- shift = 64 - (widthInBits from - widthInBits to)
-
- -- Dyadic machops:
+ ss_conv from to reg code
+ | from < to = do
+ pure $ Any (intFormat to) $ \dst ->
+ code
+ `appOL` signExtend from to reg dst
+ `appOL` truncateReg from to dst
+ | from > to =
+ pure $ Any (intFormat to) $ \dst ->
+ code
+ `appOL` toOL
+ [ ann
+ (text "MO_SS_Conv: narrow register signed" <+> ppr reg <+> ppr from <> text "->" <> ppr to)
+ (LSL (OpReg to dst) (OpReg from reg) (OpImm (ImmInt shift))),
+ -- signed right shift
+ ASR (OpReg to dst) (OpReg to dst) (OpImm (ImmInt shift))
+ ]
+ `appOL` truncateReg from to dst
+ | otherwise =
+ -- No conversion necessary: Just copy.
+ pure $ Any (intFormat from) $ \dst ->
+ code `snocOL` MOV (OpReg from dst) (OpReg from reg)
+ where
+ shift = 64 - (widthInBits from - widthInBits to)
+
+-- Dyadic machops:
--
-- The general idea is:
-- compute x<i> <- x
@@ -693,12 +686,12 @@ 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 _)]
+ CmmMachOp (MO_Add w) [CmmReg reg, CmmLit (CmmInt n _)]
| fitsIn12bitImm n -> 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 plat reg))
r' = getRegisterReg plat reg
- CmmMachOp (MO_Sub w) [(CmmReg reg), CmmLit (CmmInt n _)]
+ CmmMachOp (MO_Sub w) [CmmReg reg, CmmLit (CmmInt n _)]
| fitsIn12bitImm n -> 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 plat reg))
@@ -714,14 +707,14 @@ getRegister' config plat expr =
annExpr expr (DIVU (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
+ 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))) `appOL`
truncateReg w w dst
)
- CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do
+ CmmMachOp (MO_Shl 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`
@@ -729,7 +722,7 @@ getRegister' config plat expr =
truncateReg w w dst
)
- CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | fitsIn12bitImm n -> do
+ CmmMachOp (MO_S_Shr w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> do
(reg_x, format_x, code_x) <- getSomeReg x
(reg_x', code_x') <- signExtendReg (formatToWidth format_x) w reg_x
return $ Any (intFormat w) (
@@ -745,41 +738,37 @@ getRegister' config plat expr =
code_x `appOL` code_x' `appOL` code_y `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x') (OpReg w reg_y))
)
- CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do
+ 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 `appOL` truncateReg (formatToWidth format_x) w reg_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
- CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do
+ CmmMachOp (MO_U_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 `appOL` truncateReg (formatToWidth format_x) w reg_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
CmmMachOp (MO_U_Shr w) [x, y] | w == W8 || 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 `appOL` truncateReg (formatToWidth format_x) w reg_x `snocOL` annExpr expr (LSR (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
+ 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))))
- 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 == W64, 0 <= n, n < 64 -> 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))))
-- 3. Logic &&, ||
- CmmMachOp (MO_And w) [(CmmReg reg), CmmLit (CmmInt n _)] | fitsIn12bitImm n ->
+ CmmMachOp (MO_And w) [CmmReg reg, CmmLit (CmmInt n _)] | fitsIn12bitImm n ->
return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (AND (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n))))
where w' = formatToWidth (cmmTypeFormat (cmmRegType plat reg))
r' = getRegisterReg plat reg
- CmmMachOp (MO_Or w) [(CmmReg reg), CmmLit (CmmInt n _)] | fitsIn12bitImm n ->
+ CmmMachOp (MO_Or w) [CmmReg reg, CmmLit (CmmInt n _)] | fitsIn12bitImm n ->
return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (ORI (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n))))
where w' = formatToWidth (cmmTypeFormat (cmmRegType plat reg))
r' = getRegisterReg plat reg
-- Generic case.
CmmMachOp op [x, y] -> do
- -- alright, so we have an operation, and two expressions. And we want to essentially do
- -- ensure we get float regs (TODO(Ben): What?)
- let withTempIntReg w op = OpReg w <$> getNewRegNat (intFormat w) >>= op
- -- withTempFloatReg w op = OpReg w <$> getNewRegNat (floatFormat w) >>= op
-
+ let
-- A "plain" operation.
bitOp w op = do
-- compute x<m> <- x
@@ -796,7 +785,7 @@ getRegister' config plat expr =
-- 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].
+ -- See Note [Signed arithmetic on RISCV64].
intOp is_signed w op = do
-- compute x<m> <- x
-- compute x<o> <- y
@@ -935,9 +924,7 @@ getRegister' config plat expr =
MO_U_Shr w -> intOp False w (\d x y -> unitOL $ annExpr expr (LSR d x y))
MO_S_Shr w -> intOp True w (\d x y -> unitOL $ annExpr expr (ASR d x y))
- -- TODO
-
- op -> pprPanic "getRegister' (unhandled dyadic CmmMachOp): " $ pprMachOp op <+> text "in" <+> (pdoc plat expr)
+ op -> pprPanic "getRegister' (unhandled dyadic CmmMachOp): " $ pprMachOp op <+> text "in" <+> pdoc plat expr
CmmMachOp _op _xs
-> pprPanic "getRegister' (variadic CmmMachOp): " (pdoc plat expr)
@@ -1234,12 +1221,12 @@ genCondJump bid expr = do
-- Optimized == 0 case.
CmmMachOp (MO_Eq w) [x, CmmLit (CmmInt 0 _)] -> do
(reg_x, _format_x, code_x) <- getSomeReg x
- return $ code_x `snocOL` (annExpr expr (CBZ (OpReg w reg_x) (TBlock bid)))
+ return $ code_x `snocOL` annExpr expr (CBZ (OpReg w reg_x) (TBlock bid))
-- Optimized /= 0 case.
CmmMachOp (MO_Ne w) [x, CmmLit (CmmInt 0 _)] -> do
(reg_x, _format_x, code_x) <- getSomeReg x
- return $ code_x `snocOL` (annExpr expr (CBNZ (OpReg w reg_x) (TBlock bid)))
+ return $ code_x `snocOL` annExpr expr (CBNZ (OpReg w reg_x) (TBlock bid))
-- Generic case.
CmmMachOp mop [x, y] -> do
@@ -1481,11 +1468,11 @@ genCCall target dest_regs arg_regs bid = do
, POP_STACK_FRAME
, DELTA 0 ]
- let code = call_target_code -- compute the label (possibly into a register)
+ let code = call_target_code -- compute the label (possibly into a register)
`appOL` moveStackDown (stackSpace `div` 8)
- `appOL` passArgumentsCode -- put the arguments into x0, ...
- `appOL` (unitOL $ BL call_target passRegs returnRegs) -- branch and link.
- `appOL` readResultsCode -- parse the results into registers
+ `appOL` passArgumentsCode -- put the arguments into x0, ...
+ `snocOL` BL call_target passRegs returnRegs -- branch and link.
+ `appOL` readResultsCode -- parse the results into registers
`appOL` moveStackUp (stackSpace `div` 8)
return (code, Nothing)
@@ -1583,8 +1570,8 @@ genCCall target dest_regs arg_regs bid = do
-- Conversion
MO_UF_Conv w -> mkCCall (word2FloatLabel w)
- -- Arithmatic
- -- These are not supported on X86, so I doubt they are used much.
+ -- Optional MachOps
+ -- These are enabled/disabled by backend flags: GHC.StgToCmm.Config
MO_S_Mul2 _w -> unsupported mop
MO_S_QuotRem _w -> unsupported mop
MO_U_QuotRem _w -> unsupported mop
@@ -1756,7 +1743,7 @@ genCCall target dest_regs arg_regs bid = do
COMMENT (text "Pass gp argument sign-extended (SignedHint): " <> ppr r) `consOL`
signExtend w W64 r gpReg
- else toOL[COMMENT (text "Pass gp argument sign-extended (SignedHint): " <> ppr r)
+ else toOL [COMMENT (text "Pass gp argument sign-extended (SignedHint): " <> ppr r)
, MOV (OpReg w gpReg) (OpReg w r)]
accumCode' = accumCode `appOL`
code_r `appOL`
=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -452,7 +452,6 @@ pprInstr platform instr = case instr of
LOCATION file line' col _name
-> line (text "\t.loc" <+> int file <+> int line' <+> int col)
DELTA d -> dualDoc (asmComment $ text "\tdelta = " <> int d) empty
- -- see Note [dualLine and dualDoc] in GHC.Utils.Outputable
NEWBLOCK _ -> panic "PprInstr: NEWBLOCK"
LDATA _ _ -> panic "pprInstr: LDATA"
@@ -699,7 +698,7 @@ pprInstr platform instr = case instr of
FABS o1 o2 | isSingleOp o2 -> op2 (text "\tfabs.s") o1 o2
FABS o1 o2 | isDoubleOp o2 -> op2 (text "\tfabs.d") o1 o2
- instr -> panic $ "RV64.pprInstr - Unknown instruction: " ++ (instrCon instr)
+ instr -> panic $ "RV64.pprInstr - Unknown instruction: " ++ instrCon instr
where op2 op o1 o2 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2
op3 op o1 o2 o3 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
op4 op o1 o2 o3 o4 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
=====================================
hadrian/src/Oracles/Setting.hs
=====================================
@@ -297,7 +297,7 @@ ghcWithInterpreter = do
, "darwin", "kfreebsdgnu" ]
goodArch <- anyTargetArch [ "i386", "x86_64", "powerpc"
, "arm", "aarch64", "s390x"
- , "powerpc64", "powerpc64le" ]
+ , "powerpc64", "powerpc64le", "riscv64" ]
return $ goodOs && goodArch
-- | Variants of the ARM architecture.
=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -106,7 +106,13 @@ inTreeCompilerArgs stg = do
os <- setting HostOs
arch <- setting TargetArch
- let codegen_arches = ["x86_64", "i386", "powerpc", "powerpc64", "powerpc64le", "aarch64"]
+ let codegen_arches = [ "x86_64"
+ , "i386"
+ , "powerpc"
+ , "powerpc64"
+ , "powerpc64le"
+ , "aarch64"
+ , "riscv64" ]
let withNativeCodeGen
| unregisterised = False
| arch `elem` codegen_arches = True
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86dc603457e8946c638ac439c4db5eff1f5aca98...3e8fa876f3698eb6d54511131b2aebbe8a062dc2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86dc603457e8946c638ac439c4db5eff1f5aca98...3e8fa876f3698eb6d54511131b2aebbe8a062dc2
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/20240112/a6461450/attachment-0001.html>
More information about the ghc-commits
mailing list