X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmmStackLayout.hs;h=a2ba3f39c42a1993d56175143a80e3439a73539e;hp=60f4b5c99a56dcbde84d7f7ae8ecbfb25a66ee2e;hb=41f7ea2f3c5bc25a4a910583a9b455e88e983519;hpb=e13a12b7b217ecea358f4dd853d27ffa44d161c8

diff --git a/compiler/cmm/CmmStackLayout.hs b/compiler/cmm/CmmStackLayout.hs
index 60f4b5c..a2ba3f3 100644
--- a/compiler/cmm/CmmStackLayout.hs
+++ b/compiler/cmm/CmmStackLayout.hs
@@ -136,12 +136,20 @@ liveLastIn env l = liveInSlots (liveLastOut env l) l
 
 -- Don't forget to keep the outgoing parameters in the CallArea live,
 -- as well as the update frame.
+-- Note: We have to keep the update frame live at a call because of the
+-- case where the function doesn't return -- in that case, there won't
+-- be a return to keep the update frame live. We'd still better keep the
+-- info pointer in the update frame live at any call site;
+-- otherwise we could screw up the garbage collector.
 liveLastOut :: (BlockId -> SubAreaSet) -> Last -> SubAreaSet
 liveLastOut env l =
   case l of
-    LastCall _ Nothing  n _ -> 
+    LastCall _ Nothing n _ -> 
       add_area (CallArea Old) n out -- add outgoing args (includes upd frame)
-    LastCall _ (Just k) n _ -> add_area (CallArea (Young k)) n out
+    LastCall _ (Just k) n (Just upd_n) ->
+      add_area (CallArea Old) n (add_area (CallArea (Young k)) n out)
+    LastCall _ (Just k) n Nothing ->
+      add_area (CallArea (Young k)) n out
     _ -> out
   where out = joinOuts slotLattice env l
         add_area _ n live | n == 0 = live