[Git][ghc/ghc][wip/T22798] 3 commits: nativeGen/AArch64: Fix debugging output
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Fri Jan 20 15:55:54 UTC 2023
Ben Gamari pushed to branch wip/T22798 at Glasgow Haskell Compiler / GHC
Commits:
f31a5288 by GHC GitLab CI at 2023-01-20T07:55:47-08:00
nativeGen/AArch64: Fix debugging output
Previously various panics would rely on a half-written Show
instance, leading to very unhelpful errors. Fix this.
See #22798.
- - - - -
1325fce0 by GHC GitLab CI at 2023-01-20T07:55:47-08:00
nativeGen: Teach graph-colouring allocator that x18 is unusable
Previously trivColourable for AArch64 claimed that at 18 registers were
trivially-colourable. This is incorrect as x18 is reserved by the platform on
AArch64/Darwin.
See #22798.
- - - - -
b406d20d by GHC GitLab CI at 2023-01-20T07:55:47-08:00
nativeGen/AArch64: Fix graph-colouring allocator
Previously various `Instr` queries used by the graph-colouring allocator
failed to handle a few pseudo-instructions. This manifested in compiler
panicks while compiling `SHA`, which uses `-fregs-graph`.
Fixes #22798.
- - - - -
2 changed files:
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -72,6 +72,11 @@ instance Outputable RegUsage where
regUsageOfInstr :: Platform -> Instr -> RegUsage
regUsageOfInstr platform instr = case instr of
ANN _ i -> regUsageOfInstr platform i
+ COMMENT{} -> usage ([], [])
+ PUSH_STACK_FRAME -> usage ([], [])
+ POP_STACK_FRAME -> usage ([], [])
+ DELTA{} -> usage ([], [])
+
-- 1. Arithmetic Instructions ------------------------------------------------
ADD dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
CMN l r -> usage (regOp l ++ regOp r, [])
@@ -136,7 +141,7 @@ regUsageOfInstr platform instr = case instr of
FCVTZS dst src -> usage (regOp src, regOp dst)
FABS dst src -> usage (regOp src, regOp dst)
- _ -> panic "regUsageOfInstr"
+ _ -> panic $ "regUsageOfInstr: " ++ instrCon instr
where
-- filtering the usage is necessary, otherwise the register
@@ -200,7 +205,11 @@ callerSavedRegisters
patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr instr env = case instr of
-- 0. Meta Instructions
- ANN d i -> ANN d (patchRegsOfInstr i env)
+ ANN d i -> ANN d (patchRegsOfInstr i env)
+ COMMENT{} -> instr
+ PUSH_STACK_FRAME -> instr
+ POP_STACK_FRAME -> instr
+ DELTA{} -> instr
-- 1. Arithmetic Instructions ----------------------------------------------
ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3)
CMN o1 o2 -> CMN (patchOp o1) (patchOp o2)
@@ -266,8 +275,7 @@ patchRegsOfInstr instr env = case instr of
SCVTF o1 o2 -> SCVTF (patchOp o1) (patchOp o2)
FCVTZS o1 o2 -> FCVTZS (patchOp o1) (patchOp o2)
FABS o1 o2 -> FABS (patchOp o1) (patchOp o2)
-
- _ -> pprPanic "patchRegsOfInstr" (text $ show instr)
+ _ -> panic $ "patchRegsOfInstr: " ++ instrCon instr
where
patchOp :: Operand -> Operand
patchOp (OpReg w r) = OpReg w (env r)
@@ -323,7 +331,7 @@ patchJumpInstr instr patchF
B (TBlock bid) -> B (TBlock (patchF bid))
BL (TBlock bid) ps rs -> BL (TBlock (patchF bid)) ps rs
BCOND c (TBlock bid) -> BCOND c (TBlock (patchF bid))
- _ -> pprPanic "patchJumpInstr" (text $ show instr)
+ _ -> panic $ "patchJumpInstr: " ++ instrCon instr
-- -----------------------------------------------------------------------------
-- Note [Spills and Reloads]
@@ -635,10 +643,69 @@ data Instr
-- Float ABSolute value
| FABS Operand Operand
-instance Show Instr where
- show (LDR _f o1 o2) = "LDR " ++ show o1 ++ ", " ++ show o2
- show (MOV o1 o2) = "MOV " ++ show o1 ++ ", " ++ show o2
- show _ = "missing"
+instrCon :: Instr -> String
+instrCon i =
+ case i of
+ COMMENT{} -> "COMMENT"
+ MULTILINE_COMMENT{} -> "COMMENT"
+ ANN{} -> "ANN"
+ LOCATION{} -> "LOCATION"
+ LDATA{} -> "LDATA"
+ NEWBLOCK{} -> "NEWBLOCK"
+ DELTA{} -> "DELTA"
+ SXTB{} -> "SXTB"
+ UXTB{} -> "UXTB"
+ SXTH{} -> "SXTH"
+ UXTH{} -> "UXTH"
+ PUSH_STACK_FRAME{} -> "PUSH_STACK_FRAME"
+ POP_STACK_FRAME{} -> "POP_STACK_FRAME"
+ ADD{} -> "ADD"
+ CMN{} -> "CMN"
+ CMP{} -> "CMP"
+ MSUB{} -> "MSUB"
+ MUL{} -> "MUL"
+ NEG{} -> "NEG"
+ SDIV{} -> "SDIV"
+ SMULH{} -> "SMULH"
+ SMULL{} -> "SMULL"
+ SUB{} -> "SUB"
+ UDIV{} -> "UDIV"
+ SBFM{} -> "SBFM"
+ UBFM{} -> "UBFM"
+ SBFX{} -> "SBFX"
+ UBFX{} -> "UBFX"
+ AND{} -> "AND"
+ ANDS{} -> "ANDS"
+ ASR{} -> "ASR"
+ BIC{} -> "BIC"
+ BICS{} -> "BICS"
+ EON{} -> "EON"
+ EOR{} -> "EOR"
+ LSL{} -> "LSL"
+ LSR{} -> "LSR"
+ MOV{} -> "MOV"
+ MOVK{} -> "MOVK"
+ MVN{} -> "MVN"
+ ORN{} -> "ORN"
+ ORR{} -> "ORR"
+ ROR{} -> "ROR"
+ TST{} -> "TST"
+ STR{} -> "STR"
+ LDR{} -> "LDR"
+ STP{} -> "STP"
+ LDP{} -> "LDP"
+ CSET{} -> "CSET"
+ CBZ{} -> "CBZ"
+ CBNZ{} -> "CBNZ"
+ J{} -> "J"
+ B{} -> "B"
+ BL{} -> "BL"
+ BCOND{} -> "BCOND"
+ DMBSY{} -> "DMBSY"
+ FCVT{} -> "FCVT"
+ SCVTF{} -> "SCVTF"
+ FCVTZS{} -> "FCVTZS"
+ FABS{} -> "FABS"
data Target
= TBlock BlockId
@@ -766,11 +833,11 @@ opRegUExt W64 r = OpRegExt W64 r EUXTX 0
opRegUExt W32 r = OpRegExt W32 r EUXTW 0
opRegUExt W16 r = OpRegExt W16 r EUXTH 0
opRegUExt W8 r = OpRegExt W8 r EUXTB 0
-opRegUExt w _r = pprPanic "opRegUExt" (text $ show w)
+opRegUExt w _r = pprPanic "opRegUExt" (ppr w)
opRegSExt :: Width -> Reg -> Operand
opRegSExt W64 r = OpRegExt W64 r ESXTX 0
opRegSExt W32 r = OpRegExt W32 r ESXTW 0
opRegSExt W16 r = OpRegExt W16 r ESXTH 0
opRegSExt W8 r = OpRegExt W8 r ESXTB 0
-opRegSExt w _r = pprPanic "opRegSExt" (text $ show w)
+opRegSExt w _r = pprPanic "opRegSExt" (ppr w)
=====================================
compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs
=====================================
@@ -109,10 +109,8 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcInteger conflicts excl
ArchPPC -> 16
ArchPPC_64 _ -> 15
ArchARM _ _ _ -> panic "trivColorable ArchARM"
- -- We should be able to allocate *a lot* more in principle.
- -- essentially all 32 - SP, so 31, we'd trash the link reg
- -- as well as the platform and all others though.
- ArchAArch64 -> 18
+ -- N.B. x18 is reserved by the platform on AArch64/Darwin
+ ArchAArch64 -> 17
ArchAlpha -> panic "trivColorable ArchAlpha"
ArchMipseb -> panic "trivColorable ArchMipseb"
ArchMipsel -> panic "trivColorable ArchMipsel"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bb5462136c0498db96d73ed2d8fde5250dba7a59...b406d20d4c694383b4721f7bd91f829ceddbdf5f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bb5462136c0498db96d73ed2d8fde5250dba7a59...b406d20d4c694383b4721f7bd91f829ceddbdf5f
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/20230120/d51ddb89/attachment-0001.html>
More information about the ghc-commits
mailing list