diff --git a/rts/Disassembler.c b/rts/Disassembler.c
index b93c082a8f3c8712b65474a54a497f5f63e273b4..7c915aca779cb86f08915fcaebb8d207a38cfafa 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 0000000000000000000000000000000000000000..41f035b8ca6c309c9260453ada883c9bb2748729
--- /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 0000000000000000000000000000000000000000..d9cd60505c9511c9c30d02ed2a3ce05c8c25523e
--- /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 0000000000000000000000000000000000000000..b2650e81927b852744509fbe2c6310a0ac43305f
--- /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 0000000000000000000000000000000000000000..1e4c3e9860b074a06025ee3e79af5de783bef715
--- /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, [''])
+