[Git][ghc/ghc][master] Fix -freg-graphs for FP and AARch64 NCG (#24941).

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Sat Jul 27 13:45:38 UTC 2024



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
3f89ab92 by Andreas Klebinger at 2024-07-25T14:12:54+02:00
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.

- - - - -


7 changed files:

- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/CmmToAsm/AArch64/Regs.hs
- compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs
- docs/users_guide/9.12.1-notes.rst
- + testsuite/tests/codeGen/should_gen_asm/T24941.hs
- testsuite/tests/codeGen/should_gen_asm/all.T


Changes:

=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -177,6 +177,8 @@ regUsageOfInstr platform instr = case instr of
         interesting _        (RegVirtual _)                 = True
         interesting platform (RegReal (RealRegSingle i))    = freeReg platform i
 
+-- Note [AArch64 Register assignments]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 -- Save caller save registers
 -- This is x0-x18
 --
@@ -199,6 +201,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
 -- BR: Base, SL: SpLim
+--
+-- TODO: The zero register is currently mapped to -1 but should get it's own separate number.
 callerSavedRegisters :: [Reg]
 callerSavedRegisters
     = map regSingle [0..18]


=====================================
compiler/GHC/CmmToAsm/AArch64/Ppr.hs
=====================================
@@ -316,6 +316,7 @@ pprReg w r = case r of
          | w == W64 = text "sp"
          | w == W32 = text "wsp"
 
+    -- See Note [AArch64 Register assignments]
     ppr_reg_no w i
          | i < 0, w == W32 = text "wzr"
          | i < 0, w == W64 = text "xzr"


=====================================
compiler/GHC/CmmToAsm/AArch64/Regs.hs
=====================================
@@ -17,6 +17,7 @@ import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Platform
 
+-- TODO: Should this include the zero register?
 allMachRegNos   :: [RegNo]
 allMachRegNos   = [0..31] ++ [32..63]
 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.


=====================================
compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs
=====================================
@@ -183,7 +183,8 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcDouble conflicts exclu
                             ArchPPC       -> 26
                             ArchPPC_64 _  -> 20
                             ArchARM _ _ _ -> panic "trivColorable ArchARM"
-                            ArchAArch64   -> 28 -- 32 - D1..D4
+                            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"
                             ArchMipseb    -> panic "trivColorable ArchMipseb"
                             ArchMipsel    -> panic "trivColorable ArchMipsel"


=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -78,12 +78,15 @@ Compiler
   <https://gitlab.haskell.org/ghc/ghc/-/issues/24921>`_). This does
   not affect existing support of apple systems on x86_64/aarch64.
 
-- The flag :ghc-flag:`-fignore-asserts` will now also enable the 
+- The flag :ghc-flag:`-fignore-asserts` will now also enable the
   :extension:`CPP` macro ``__GLASGOW_HASKELL_ASSERTS_IGNORED__`` (`#24967
   <https://gitlab.haskell.org/ghc/ghc/-/issues/24967>`_).
   This enables people to write their own custom assertion functions.
   See :ref:`assertions`.
-  
+
+- Fixed a bug that caused GHC to panic when using the aarch64 ncg and -fregs-graph
+  on certain programs. (#24941)
+
 
 GHCi
 ~~~~


=====================================
testsuite/tests/codeGen/should_gen_asm/T24941.hs
=====================================
@@ -0,0 +1,23 @@
+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


=====================================
testsuite/tests/codeGen/should_gen_asm/all.T
=====================================
@@ -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-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('T24941', [only_ways(['optasm'])], compile, ['-fregs-graph'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f89ab92da74c4ed45da68fe92ff81e7b9caa53d

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f89ab92da74c4ed45da68fe92ff81e7b9caa53d
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/20240727/ae88ab28/attachment-0001.html>


More information about the ghc-commits mailing list