[commit: ghc] ghc-generics1: throwTo: unlock the MSG_THROWTO object before returning (#6103) (4b5047c)

[José Pedro Magalhães]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : ghc-generics1

http://hackage.haskell.org/trac/ghc/changeset/4b5047c074fef59ef0086fd4bd5e5fa34d4f7544

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

commit 4b5047c074fef59ef0086fd4bd5e5fa34d4f7544
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Tue Jun 5 09:05:47 2012 +0100

    throwTo: unlock the MSG_THROWTO object before returning (#6103)

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

 rts/RaiseAsync.c |   10 ++++++++--
 1 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index c14b411..9e5a8c3 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -156,8 +156,7 @@ throwTo (Capability *cap,	// the Capability we hold
     MessageThrowTo *msg;
 
     msg = (MessageThrowTo *) allocate(cap, sizeofW(MessageThrowTo));
-    // message starts locked; the caller has to unlock it when it is
-    // ready.
+    // the message starts locked; see below
     SET_HDR(msg, &stg_WHITEHOLE_info, CCS_SYSTEM);
     msg->source      = source;
     msg->target      = target;
@@ -166,9 +165,16 @@ throwTo (Capability *cap,	// the Capability we hold
     switch (throwToMsg(cap, msg))
     {
     case THROWTO_SUCCESS:
+        // unlock the message now, otherwise we leave a WHITEHOLE in
+        // the heap (#6103)
+        SET_HDR(msg, &stg_MSG_THROWTO_info, CCS_SYSTEM);
         return NULL;
+
     case THROWTO_BLOCKED:
     default:
+        // the caller will unlock the message when it is ready.  We
+        // cannot unlock it yet, because the calling thread will need
+        // to tidy up its state first.
         return msg;
     }
 }