[commit: ghc] master: Fix heap corruption during stable name allocation (691aa71)

[git at git.haskell.org]

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

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

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

commit 691aa715cf43bf9d88ee32bca37e471bae35adfb
Author: Ömer Sinan Ağacan <omeragacan at gmail.com>
Date:   Wed Nov 21 20:03:38 2018 +0300

    Fix heap corruption during stable name allocation
    
    See #15906 for the problem. To fix we simply call `allocate()` instead of
    `ALLOC_PRIM()`. `allocate()` does not trigger GC when the nursery is full,
    instead it extends it.
    
    Test Plan:
    This validates. memo001 now passes with `-debug` compile parameter. I'll add
    another test that runs memo001 with `-debug` once I figure out how to use
    stdout files for multiple tests.
    
    Reviewers: simonmar, bgamari, erikd
    
    Reviewed By: simonmar
    
    Subscribers: rwbarton, carter
    
    GHC Trac Issues: #15906
    
    Differential Revision: https://phabricator.haskell.org/D5342


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

691aa715cf43bf9d88ee32bca37e471bae35adfb
 rts/PrimOps.cmm | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index a5d8553..625f5f5 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1893,14 +1893,25 @@ stg_makeStableNamezh ( P_ obj )
 {
     W_ index, sn_obj;
 
+    MAYBE_GC_P(stg_makeStableNamezh, obj);
+
     (index) = ccall lookupStableName(obj "ptr");
 
     /* Is there already a StableName for this heap object?
      *  stable_name_table is a pointer to an array of snEntry structs.
      */
     if ( snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry) == NULL ) {
-        ALLOC_PRIM (SIZEOF_StgStableName);
-        sn_obj = Hp - SIZEOF_StgStableName + WDS(1);
+        // At this point we have a snEntry, but it doesn't look as used to the
+        // GC yet because we don't have a StableName object for the sn_obj field
+        // (remember that sn_obj == NULL means the entry is free). So if we call
+        // GC here we end up skipping the snEntry in gcStableNameTable(). This
+        // caused #15906. Solution: use allocate(), which does not call GC.
+        //
+        // (Alternatively we could use a special value for the sn_obj field to
+        // indicate that the entry is being allocated and not free, but that's
+        // too complicated and doesn't buy us much. See D5342?id=18700.)
+        ("ptr" sn_obj) = ccall allocate(MyCapability() "ptr",
+                                        BYTES_TO_WDS(SIZEOF_StgStableName));
         SET_HDR(sn_obj, stg_STABLE_NAME_info, CCCS);
         StgStableName_sn(sn_obj) = index;
         snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry) = sn_obj;