From 721ac00d63216e5e6512baba09b6ebb3cc456ebf Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Mon, 14 Oct 2024 14:47:02 -0400
Subject: [PATCH] rts/Disassembler: Fix encoding of BRK_FUN instruction
The offset of the CC field was not updated after the encoding change in
b85b11994e0130ff2401dd4bbdf52330e0bcf776. Fix this.
Fixes #25374.
---
rts/Disassembler.c | 4 ++--
testsuite/tests/codeGen/should_run/T25374/T25374.hs | 8 ++++++++
.../tests/codeGen/should_run/T25374/T25374.script | 2 ++
testsuite/tests/codeGen/should_run/T25374/T25374A.hs | 12 ++++++++++++
testsuite/tests/codeGen/should_run/T25374/all.T | 3 +++
5 files changed, 27 insertions(+), 2 deletions(-)
create mode 100644 testsuite/tests/codeGen/should_run/T25374/T25374.hs
create mode 100644 testsuite/tests/codeGen/should_run/T25374/T25374.script
create mode 100644 testsuite/tests/codeGen/should_run/T25374/T25374A.hs
create mode 100644 testsuite/tests/codeGen/should_run/T25374/all.T
diff --git a/rts/Disassembler.c b/rts/Disassembler.c
index b93c082a8f3..7c915aca779 100644
--- a/rts/Disassembler.c
+++ b/rts/Disassembler.c
@@ -67,12 +67,12 @@ disInstr ( StgBCO *bco, int pc )
case bci_BRK_FUN:
debugBelch ("BRK_FUN " ); printPtr( ptrs[instrs[pc]] );
debugBelch (" %d ", instrs[pc+1]); printPtr( ptrs[instrs[pc+2]] );
- CostCentre* cc = (CostCentre*)literals[instrs[pc+3]];
+ CostCentre* cc = (CostCentre*)literals[instrs[pc+5]];
if (cc) {
debugBelch(" %s", cc->label);
}
debugBelch("\n");
- pc += 4;
+ pc += 6;
break;
case bci_SWIZZLE: {
W_ stkoff = BCO_GET_LARGE_ARG;
diff --git a/testsuite/tests/codeGen/should_run/T25374/T25374.hs b/testsuite/tests/codeGen/should_run/T25374/T25374.hs
new file mode 100644
index 00000000000..41f035b8ca6
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T25374/T25374.hs
@@ -0,0 +1,8 @@
+import T25374A
+
+fieldsSam :: NP xs -> NP xs -> Bool
+fieldsSam UNil UNil = True
+
+x :: Bool
+x = fieldsSam UNil UNil
+
diff --git a/testsuite/tests/codeGen/should_run/T25374/T25374.script b/testsuite/tests/codeGen/should_run/T25374/T25374.script
new file mode 100644
index 00000000000..d9cd60505c9
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T25374/T25374.script
@@ -0,0 +1,2 @@
+:load T25374
+x
diff --git a/testsuite/tests/codeGen/should_run/T25374/T25374A.hs b/testsuite/tests/codeGen/should_run/T25374/T25374A.hs
new file mode 100644
index 00000000000..b2650e81927
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T25374/T25374A.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE UnliftedDatatypes #-}
+
+module T25374A where
+
+import GHC.Exts
+
+type NP :: [UnliftedType] -> UnliftedType
+data NP xs where
+ UNil :: NP '[]
+ (::*) :: x -> NP xs -> NP (x ': xs)
+
diff --git a/testsuite/tests/codeGen/should_run/T25374/all.T b/testsuite/tests/codeGen/should_run/T25374/all.T
new file mode 100644
index 00000000000..1e4c3e9860b
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T25374/all.T
@@ -0,0 +1,3 @@
+# This shouldn't crash the disassembler
+test('T25374', [extra_hc_opts('+RTS -Di -RTS'), ignore_stderr, unless(debug_rts(), skip)], ghci_script, [''])
+
--
GitLab