Skip to content
Snippets Groups Projects
Commit 4cbf2581 authored by Andreas Klebinger's avatar Andreas Klebinger Committed by Ben Gamari
Browse files

Fix -freg-graphs for FP and AARch64 NCG (#24941).

It seems we reserve 8 registers instead of four for global regs
based on the layout in Note [AArch64 Register assignments].

I'm not sure it's neccesary, but for now we just accept this state of
affairs and simple update -fregs-graph to account for this.

(cherry picked from commit 3f89ab92)
parent ed8f2c53
No related branches found
No related tags found
No related merge requests found
...@@ -176,6 +176,8 @@ regUsageOfInstr platform instr = case instr of ...@@ -176,6 +176,8 @@ regUsageOfInstr platform instr = case instr of
interesting _ (RegReal (RealRegSingle (-1))) = False interesting _ (RegReal (RealRegSingle (-1))) = False
interesting platform (RegReal (RealRegSingle i)) = freeReg platform i interesting platform (RegReal (RealRegSingle i)) = freeReg platform i
-- Note [AArch64 Register assignments]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Save caller save registers -- Save caller save registers
-- This is x0-x18 -- This is x0-x18
-- --
...@@ -198,6 +200,8 @@ regUsageOfInstr platform instr = case instr of ...@@ -198,6 +200,8 @@ regUsageOfInstr platform instr = case instr of
-- '---------------------------------------------------------------------------------------------------------------------------------------------------------------' -- '---------------------------------------------------------------------------------------------------------------------------------------------------------------'
-- IR: Indirect result location register, IP: Intra-procedure register, PL: Platform register, FP: Frame pointer, LR: Link register, SP: Stack pointer -- IR: Indirect result location register, IP: Intra-procedure register, PL: Platform register, FP: Frame pointer, LR: Link register, SP: Stack pointer
-- BR: Base, SL: SpLim -- BR: Base, SL: SpLim
--
-- TODO: The zero register is currently mapped to -1 but should get it's own separate number.
callerSavedRegisters :: [Reg] callerSavedRegisters :: [Reg]
callerSavedRegisters callerSavedRegisters
= map regSingle [0..18] = map regSingle [0..18]
......
...@@ -317,6 +317,7 @@ pprReg w r = case r of ...@@ -317,6 +317,7 @@ pprReg w r = case r of
| w == W64 = text "sp" | w == W64 = text "sp"
| w == W32 = text "wsp" | w == W32 = text "wsp"
-- See Note [AArch64 Register assignments]
ppr_reg_no w i ppr_reg_no w i
| i < 0, w == W32 = text "wzr" | i < 0, w == W32 = text "wzr"
| i < 0, w == W64 = text "xzr" | i < 0, w == W64 = text "xzr"
......
...@@ -17,6 +17,7 @@ import GHC.Utils.Outputable ...@@ -17,6 +17,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Panic import GHC.Utils.Panic
import GHC.Platform import GHC.Platform
-- TODO: Should this include the zero register?
allMachRegNos :: [RegNo] allMachRegNos :: [RegNo]
allMachRegNos = [0..31] ++ [32..63] allMachRegNos = [0..31] ++ [32..63]
-- allocatableRegs is allMachRegNos with the fixed-use regs removed. -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
......
...@@ -179,7 +179,8 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcDouble conflicts exclu ...@@ -179,7 +179,8 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcDouble conflicts exclu
ArchPPC -> 26 ArchPPC -> 26
ArchPPC_64 _ -> 20 ArchPPC_64 _ -> 20
ArchARM _ _ _ -> panic "trivColorable ArchARM" ArchARM _ _ _ -> panic "trivColorable ArchARM"
ArchAArch64 -> 32 ArchAArch64 -> 24 -- 32 - F1 .. F4, D1..D4 - it's odd but see Note [AArch64 Register assignments] for our reg use.
-- Seems we reserve different registers for D1..D4 and F1 .. F4 somehow, we should fix this.
ArchAlpha -> panic "trivColorable ArchAlpha" ArchAlpha -> panic "trivColorable ArchAlpha"
ArchMipseb -> panic "trivColorable ArchMipseb" ArchMipseb -> panic "trivColorable ArchMipseb"
ArchMipsel -> panic "trivColorable ArchMipsel" ArchMipsel -> panic "trivColorable ArchMipsel"
......
...@@ -5,3 +5,15 @@ Version 9.8.3 ...@@ -5,3 +5,15 @@ Version 9.8.3
The :ghc-flag:`LLVM backend <-fllvm>` of this release is to be used with LLVM The :ghc-flag:`LLVM backend <-fllvm>` of this release is to be used with LLVM
11, 12, 13, 14 or 15. 11, 12, 13, 14 or 15.
Significant Changes
~~~~~~~~~~~~~~~~~~~~
Issues fixed in this release include:
Compiler
--------
- Fixed a bug that caused GHC to panic when using the AArch64 ncg and :ghc-flag:`-fregs-graph`
on certain programs (:ghc-ticket:`24941`).
module T24941 where
data F = F
!Float !Float !Float !Float !Float !Float !Float !Float !Float !Float
!Float !Float !Float !Float !Float !Float !Float !Float !Float !Float
!Float !Float !Float !Float !Float !Float !Float !Float !Float !Float
!Float !Float
foo ( F
x00 x01 x02 x03 x04 x05 x06 x07 x08 x09
x10 x11 x12 x13 x14 x15 x16 x17 x18 x19
x20 x21 x22 x23 x24 x25 x26 x27 x28 x29
x30 x31
)
=
F
x00 x01 x02 x03 x04 x05 x06 x07 x08 x09
x10 x11 x12 x13 x14 x15 x16 x17 x18 x19
x20 x21 x22 x23 x24 x25 x26 x27 x28 x29
x30 (x31+1)
\ No newline at end of file
...@@ -10,3 +10,5 @@ test('memset-unroll', is_amd64_codegen, compile_cmp_asm, ['cmm', '']) ...@@ -10,3 +10,5 @@ test('memset-unroll', is_amd64_codegen, compile_cmp_asm, ['cmm', ''])
test('bytearray-memset-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, '']) test('bytearray-memset-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, ''])
test('bytearray-memcpy-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, '']) test('bytearray-memcpy-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, ''])
test('T18137', [when(opsys('darwin'), skip), only_ways(llvm_ways)], compile_grep_asm, ['hs', False, '-fllvm -split-sections']) test('T18137', [when(opsys('darwin'), skip), only_ways(llvm_ways)], compile_grep_asm, ['hs', False, '-fllvm -split-sections'])
test('T24941', [only_ways(['optasm'])], compile, ['-fregs-graph'])
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment