merge (ghc-5-02-branch --> HEAD):
Bugfix: there was an implicit assumption that the list of slots passed
to freeStackSlots was already sorted, whereas in fact this wasn't the
case for at least one call. Now we explicitly sort the list in
freeStackSlots, removing the hidden assumption.
The symptoms of this bug include crashes (perhaps the "AsmCodeGen"
crash), and a tendency to grow the stack a lot when let-no-escapes are
involved (because the bug caused fragmentation of the stack free list,
so we weren't re-using free slots properly).
1.17.2.1 +3 -2 fptools/ghc/compiler/codeGen/CgStackery.lhs
ASSERT that the list of stack slots we calculate in buildLivenessMask
is sorted, because we rely on that property later.
1.38.2.1 +5 -6 fptools/ghc/compiler/codeGen/CgBindery.lhs
import CLabel ( mkClosureLabel,
mkBitmapLabel, pprCLabel )
import ClosureInfo ( mkLFImported, mkLFArgument, LambdaFormInfo )
import CLabel ( mkClosureLabel,
mkBitmapLabel, pprCLabel )
import ClosureInfo ( mkLFImported, mkLFArgument, LambdaFormInfo )
-import BitSet ( mkBS, emptyBS )
import PrimRep ( isFollowableRep, getPrimRepSize )
import Id ( Id, idPrimRep, idType )
import Type ( typePrimRep )
import PrimRep ( isFollowableRep, getPrimRepSize )
import Id ( Id, idPrimRep, idType )
import Type ( typePrimRep )
-> FCode Liveness -- mask for free/unlifted slots
buildLivenessMask uniq sp = do
-> FCode Liveness -- mask for free/unlifted slots
buildLivenessMask uniq sp = do
-- find all unboxed stack-resident ids
binds <- getBinds
((vsp, free, _, _), heap_usage) <- getUsage
-- find all unboxed stack-resident ids
binds <- getBinds
((vsp, free, _, _), heap_usage) <- getUsage
let rel_slots = reverse (map (sp-) all_slots)
-- build the bitmap
let rel_slots = reverse (map (sp-) all_slots)
-- build the bitmap
- let liveness_mask = ASSERT(all (>=0) rel_slots) (listToLivenessMask rel_slots)
+ let liveness_mask
+ = ASSERT(all (>=0) rel_slots
+ && rel_slots == sortLt (<) rel_slots)
+ (listToLivenessMask rel_slots)
livenessToAbsC uniq liveness_mask
livenessToAbsC uniq liveness_mask
dead_slots live_vars
[] []
[ (i, b) | b@(MkCgIdInfo i _ _ _) <- rngVarEnv binds ]
dead_slots live_vars
[] []
[ (i, b) | b@(MkCgIdInfo i _ _ _) <- rngVarEnv binds ]
- let extra_free = sortLt (<) dead_stk_slots
- freeStackSlots extra_free
+ freeStackSlots dead_stk_slots
\end{code}
Several boring auxiliary functions to do the dirty work.
\end{code}
Several boring auxiliary functions to do the dirty work.
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgStackery.lhs,v 1.18 2001/08/31 12:39:06 rje Exp $
+% $Id: CgStackery.lhs,v 1.19 2001/09/12 15:52:40 sewardj Exp $
%
\section[CgStackery]{Stack management functions}
%
\section[CgStackery]{Stack management functions}
import Constants ( uF_SIZE, sCC_UF_SIZE, gRAN_UF_SIZE,
sEQ_FRAME_SIZE, sCC_SEQ_FRAME_SIZE, gRAN_SEQ_FRAME_SIZE )
import Constants ( uF_SIZE, sCC_UF_SIZE, gRAN_UF_SIZE,
sEQ_FRAME_SIZE, sCC_SEQ_FRAME_SIZE, gRAN_SEQ_FRAME_SIZE )
import IOExts ( trace )
\end{code}
import IOExts ( trace )
\end{code}
addFreeStackSlots :: [VirtualSpOffset] -> Slot -> Code
addFreeStackSlots extra_free slot = do
((vsp, free, real, hw),heap_usage) <- getUsage
addFreeStackSlots :: [VirtualSpOffset] -> Slot -> Code
addFreeStackSlots extra_free slot = do
((vsp, free, real, hw),heap_usage) <- getUsage
- let all_free = addFreeSlots free (zip extra_free (repeat slot))
+ let all_free = addFreeSlots free (zip (sortLt (<) extra_free) (repeat slot))
let (new_vsp, new_free) = trim vsp all_free
let new_usage = ((new_vsp, new_free, real, hw), heap_usage)
setUsage new_usage
let (new_vsp, new_free) = trim vsp all_free
let new_usage = ((new_vsp, new_free, real, hw), heap_usage)
setUsage new_usage