summaryrefslogtreecommitdiff
path: root/compiler/cmm/CmmStackLayout.hs
diff options
context:
space:
mode:
authordias@eecs.harvard.edu <unknown>2008-10-14 16:54:37 +0000
committerdias@eecs.harvard.edu <unknown>2008-10-14 16:54:37 +0000
commit41f7ea2f3c5bc25a4a910583a9b455e88e983519 (patch)
tree6229d5e7215128676cc31a60acd44e4d1dd2cef0 /compiler/cmm/CmmStackLayout.hs
parente13a12b7b217ecea358f4dd853d27ffa44d161c8 (diff)
downloadhaskell-41f7ea2f3c5bc25a4a910583a9b455e88e983519.tar.gz
Keep update frames live even in functions that never return
An unusual case, but without it: (a) we had an assertion failure (b) we can overwrite the caller's infotable, which might cause the garbage collector to collect live data. Better to keep the update frame live at all call sites, not just at returns.
Diffstat (limited to 'compiler/cmm/CmmStackLayout.hs')
-rw-r--r--compiler/cmm/CmmStackLayout.hs12
1 files changed, 10 insertions, 2 deletions
diff --git a/compiler/cmm/CmmStackLayout.hs b/compiler/cmm/CmmStackLayout.hs
index 60f4b5c99a..a2ba3f39c4 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