[commit: ghc] master: Untag the potential AP_STACK in stg_getApStackValzh (b6204f7)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/b6204f70501ec4ce4015503421c8a83c6f0fa008/ghc

>---------------------------------------------------------------

commit b6204f70501ec4ce4015503421c8a83c6f0fa008
Author: James Clarke <jrtc27 at jrtc27.com>
Date:   Wed Oct 18 16:33:28 2017 -0400

    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


>---------------------------------------------------------------

b6204f70501ec4ce4015503421c8a83c6f0fa008
 rts/PrimOps.cmm                                                      | 2 +-
 testsuite/tests/ghci.debugger/scripts/all.T                          | 5 ++++-
 .../tests/ghci.debugger/scripts/{hist001.script => hist002.script}   | 5 +++++
 .../tests/ghci.debugger/scripts/{hist001.stdout => hist002.stdout}   | 0
 4 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index bcf7b62..ca519b6 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 d62dcd9..00a39d7 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/hist001.script b/testsuite/tests/ghci.debugger/scripts/hist002.script
similarity index 51%
copy from testsuite/tests/ghci.debugger/scripts/hist001.script
copy to testsuite/tests/ghci.debugger/scripts/hist002.script
index a15b3b1..0198207 100644
--- a/testsuite/tests/ghci.debugger/scripts/hist001.script
+++ b/testsuite/tests/ghci.debugger/scripts/hist002.script
@@ -9,6 +9,11 @@
 :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)
diff --git a/testsuite/tests/ghci.debugger/scripts/hist001.stdout b/testsuite/tests/ghci.debugger/scripts/hist002.stdout
similarity index 100%
copy from testsuite/tests/ghci.debugger/scripts/hist001.stdout
copy to testsuite/tests/ghci.debugger/scripts/hist002.stdout