summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJames Clarke <jrtc27@jrtc27.com>2017-10-18 16:33:28 -0400
committerBen Gamari <ben@smart-cactus.org>2017-10-19 16:40:09 -0400
commitb6204f70501ec4ce4015503421c8a83c6f0fa008 (patch)
treee2d5b6daa6738a582700405235cb58a6c7bf6ddd
parent098dc97b80768a6aeabce4eb6d6d7e6e9a9a75b6 (diff)
downloadhaskell-b6204f70501ec4ce4015503421c8a83c6f0fa008.tar.gz
Untag the potential AP_STACK in stg_getApStackValzh
If the AP_STACK has been evaluated and a GC has run, the BLACKHOLE indirection will have been removed, and the StablePtr for the original AP_STACK referred to be GHCi will therefore now point directly to the value, and may be tagged. Add a hist002 test for this, and make sure hist001 doesn't do an idle GC, so the case when it's still a BLACKHOLE is definitely also tested. Reviewers: austin, bgamari, erikd, simonmar Reviewed By: simonmar Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4099
-rw-r--r--rts/PrimOps.cmm2
-rw-r--r--testsuite/tests/ghci.debugger/scripts/all.T5
-rw-r--r--testsuite/tests/ghci.debugger/scripts/hist002.script20
-rw-r--r--testsuite/tests/ghci.debugger/scripts/hist002.stdout37
4 files changed, 62 insertions, 2 deletions
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index bcf7b62fb7..ca519b60e7 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -2391,7 +2391,7 @@ stg_noDuplicatezh /* no arg list: explicit stack layout */
stg_getApStackValzh ( P_ ap_stack, W_ offset )
{
- if (%INFO_PTR(ap_stack) == stg_AP_STACK_info) {
+ if (%INFO_PTR(UNTAG(ap_stack)) == stg_AP_STACK_info) {
return (1,StgAP_STACK_payload(ap_stack,offset));
} else {
return (0,ap_stack);
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index d62dcd97e0..00a39d704e 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -84,7 +84,10 @@ test('listCommand001', [extra_files(['../Test3.hs']),
combined_output], ghci_script, ['listCommand001.script'])
test('listCommand002', normal, ghci_script, ['listCommand002.script'])
-test('hist001', extra_files(['../Test3.hs']), ghci_script, ['hist001.script'])
+test('hist001', [extra_files(['../Test3.hs']), extra_run_opts('+RTS -I0')],
+ ghci_script, ['hist001.script'])
+test('hist002', [extra_files(['../Test3.hs']), extra_run_opts('+RTS -I0')],
+ ghci_script, ['hist002.script'])
test('T2740', normal, ghci_script, ['T2740.script'])
diff --git a/testsuite/tests/ghci.debugger/scripts/hist002.script b/testsuite/tests/ghci.debugger/scripts/hist002.script
new file mode 100644
index 0000000000..0198207192
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/hist002.script
@@ -0,0 +1,20 @@
+:l Test3.hs
+-- set a break on the [] case in map
+:b 1
+-- trace an execution
+:tr mymap (+1) [1,2]
+:hist
+:back
+:show bindings
+:back
+:show bindings
+:force _result
+-- Run a GC so the BLACKHOLE indirection for _result (the AP_STACK) is removed,
+-- ensuring _result now points directly to the value (in this case, the integer
+-- 3). This will be tagged, so we are checking that the pointer isn't naively
+-- dereferenced to generate an unaligned load.
+System.Mem.performGC
+:back
+:forward
+-- at this point, we can't retrieve the bindings because _result (the AP_STACK)
+-- was evaluated previously. GHCi should not crash, preferably.
diff --git a/testsuite/tests/ghci.debugger/scripts/hist002.stdout b/testsuite/tests/ghci.debugger/scripts/hist002.stdout
new file mode 100644
index 0000000000..523605b00a
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/hist002.stdout
@@ -0,0 +1,37 @@
+Breakpoint 0 activated at Test3.hs:1:14-15
+[2,3Stopped in Main.mymap, Test3.hs:1:14-15
+_result :: [a] = _
+-1 : mymap (Test3.hs:2:22-31)
+-2 : mymap (Test3.hs:2:18-20)
+-3 : mymap (Test3.hs:2:18-31)
+-4 : mymap (Test3.hs:2:22-31)
+-5 : mymap (Test3.hs:2:18-20)
+-6 : mymap (Test3.hs:2:18-31)
+<end of history>
+Logged breakpoint at Test3.hs:2:22-31
+_result :: [a]
+f :: t -> a
+xs :: [t]
+Ghci1._result :: [a] = _
+xs :: [t] = []
+f :: t -> a = _
+_result :: [a] = _
+Logged breakpoint at Test3.hs:2:18-20
+_result :: a
+f :: Integer -> a
+x :: Integer
+Ghci1._result :: [a] = _
+xs :: [t] = []
+Ghci2.f :: t -> a = _
+Ghci2._result :: [a] = _
+x :: Integer = 2
+f :: Integer -> a = _
+_result :: a = _
+_result = 3
+Logged breakpoint at Test3.hs:2:18-31
+_result :: [a]
+f :: Integer -> a
+x :: Integer
+xs :: [Integer]
+Logged breakpoint at Test3.hs:2:18-20
+_result :: a