[commit: ghc] master: Make rts/ThreadLabels.c threadsafe for debug runtime. (74897de)

[git at git.haskell.org]

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

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

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

commit 74897dece3ea92139b552bd711903ce630956df3
Author: Sergei Trofimovich <slyfox at gentoo.org>
Date:   Mon Aug 17 23:14:42 2015 +0100

    Make rts/ThreadLabels.c threadsafe for debug runtime.
    
    rts/ThreadLabels.c has a global hashtable for each
    running haskell thread. It's not synchronized across
    OS threads.
    
    Was discovered when ran -debug build of ghc itself as:
    
        $ ghc-stage2 -j8 +RTS -A256M -l
    
    and glibc detected double-free corruption:
    
        #2  in __libc_message (do_abort=do_abort at entry=2,
            fmt=fmt at entry=0x7fe0bcebf368 "*** Error in `%s': %s: 0x%s ***\n")
        #3  in malloc_printerr (action=3, str=0x7fe0bcebf4c0 "double free or corruption (fasttop)",
            ptr=<optimized out>)
        #4  in _int_free (av=<optimized out>, p=<optimized out>, have_lock=0)
        #5  in stgFree (p=0x7fe060001820) at rts/RtsUtils.c:108
        #6  in freeHashTable (table=0x5929320, freeDataFun=0x36374df <stgFree>) at rts/Hash.c:360
        #7  in freeThreadLabelTable () at rts/ThreadLabels.c:37
        #8  in hs_exit_ (wait_foreign=rtsFalse) at rts/RtsStartup.c:403
        #9  in shutdownHaskellAndExit (n=0, fastExit=0) at rts/RtsStartup.c:481
        #10 in hs_main (...) at rts/RtsMain.c:91
        #11 in main (...) at ghc/hschooks.c:63
    
    Exposed itself after commit:
    
    > commit f6866824ce5cdf5359f0cad78c49d65f6d43af12
    > Author: Sergei Trofimovich <slyfox at gentoo.org>
    > Date:   Mon Aug 4 08:10:33 2014 -0500
    >
    >     ghc --make: add nicer names to RTS threads (threaded IO manager, make workers)
    
    Signed-off-by: Sergei Trofimovich <siarheit at google.com>
    
    Reviewers: austin, simonmar, ezyang, bgamari
    
    Reviewed By: ezyang, bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D1146


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

74897dece3ea92139b552bd711903ce630956df3
 rts/ThreadLabels.c | 30 +++++++++++++++++++++++++++++-
 1 file changed, 29 insertions(+), 1 deletion(-)

diff --git a/rts/ThreadLabels.c b/rts/ThreadLabels.c
index 981a5d9..7a06580 100644
--- a/rts/ThreadLabels.c
+++ b/rts/ThreadLabels.c
@@ -20,11 +20,19 @@
 
 #if defined(DEBUG)
 
+#if defined(THREADED_RTS)
+static Mutex threadLabels_mutex;
+#endif /* THREADED_RTS */
+
 static HashTable * threadLabels = NULL;
 
 void
 initThreadLabelTable(void)
 {
+#if defined(THREADED_RTS)
+  initMutex(&threadLabels_mutex);
+#endif /* THREADED_RTS */
+
   if (threadLabels == NULL) {
     threadLabels = allocHashTable();
   }
@@ -33,33 +41,53 @@ initThreadLabelTable(void)
 void
 freeThreadLabelTable(void)
 {
+    ACQUIRE_LOCK(&threadLabels_mutex);
+
     if (threadLabels != NULL) {
         freeHashTable(threadLabels, stgFree);
         threadLabels = NULL;
     }
+
+    RELEASE_LOCK(&threadLabels_mutex);
 }
 
 static void
 updateThreadLabel(StgWord key, void *data)
 {
   removeThreadLabel(key);
+
+  ACQUIRE_LOCK(&threadLabels_mutex);
+
   insertHashTable(threadLabels,key,data);
+
+  RELEASE_LOCK(&threadLabels_mutex);
 }
 
 void *
 lookupThreadLabel(StgWord key)
 {
-  return lookupHashTable(threadLabels,key);
+  void * result;
+  ACQUIRE_LOCK(&threadLabels_mutex);
+
+  result = lookupHashTable(threadLabels,key);
+
+  RELEASE_LOCK(&threadLabels_mutex);
+
+  return result;
 }
 
 void
 removeThreadLabel(StgWord key)
 {
+  ACQUIRE_LOCK(&threadLabels_mutex);
+
   void * old = NULL;
   if ((old = lookupHashTable(threadLabels,key))) {
     removeHashTable(threadLabels,key,old);
     stgFree(old);
   }
+
+  RELEASE_LOCK(&threadLabels_mutex);
 }
 
 #endif /* DEBUG */