From: sewardj <unknown>
Date: Wed, 12 Sep 2001 15:52:40 +0000 (+0000)
Subject: [project @ 2001-09-12 15:52:40 by sewardj]
X-Git-Tag: Approximately_9120_patches~986
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=7a846c96fdd5f336fa39c12112dc60dd2d3a1e95;p=ghc-hetmet.git

[project @ 2001-09-12 15:52:40 by sewardj]
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
---

diff --git a/ghc/compiler/codeGen/CgBindery.lhs b/ghc/compiler/codeGen/CgBindery.lhs
index fb9916f..76c5542 100644
--- a/ghc/compiler/codeGen/CgBindery.lhs
+++ b/ghc/compiler/codeGen/CgBindery.lhs
@@ -36,7 +36,7 @@ import CgStackery	( freeStackSlots )
 import CLabel		( mkClosureLabel,
 			  mkBitmapLabel, pprCLabel )
 import ClosureInfo	( mkLFImported, mkLFArgument, LambdaFormInfo )
-import BitSet		( mkBS, emptyBS )
+import BitSet
 import PrimRep		( isFollowableRep, getPrimRepSize )
 import Id		( Id, idPrimRep, idType )
 import Type		( typePrimRep )
@@ -452,6 +452,7 @@ buildLivenessMask
 	-> FCode Liveness	-- mask for free/unlifted slots
 
 buildLivenessMask uniq sp = do	
+
 	-- find all unboxed stack-resident ids
 	binds <- getBinds
 	((vsp, free, _, _), heap_usage) <- getUsage
@@ -477,7 +478,10 @@ buildLivenessMask uniq sp = do
 	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
 
@@ -547,9 +551,8 @@ nukeDeadBindings live_vars = do
 		dead_slots live_vars 
 			[] []
 			[ (i, b) | b@(MkCgIdInfo i _ _ _) <- rngVarEnv binds ]
-	let extra_free = sortLt (<) dead_stk_slots
 	setBinds $ mkVarEnv bs'
-	freeStackSlots extra_free
+	freeStackSlots dead_stk_slots
 \end{code}
 
 Several boring auxiliary functions to do the dirty work.
diff --git a/ghc/compiler/codeGen/CgStackery.lhs b/ghc/compiler/codeGen/CgStackery.lhs
index 3a2598e..896cfc7 100644
--- a/ghc/compiler/codeGen/CgStackery.lhs
+++ b/ghc/compiler/codeGen/CgStackery.lhs
@@ -1,7 +1,7 @@
 %
 % (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}
 
@@ -30,6 +30,7 @@ import Panic		( panic )
 import Constants	( uF_SIZE, sCC_UF_SIZE, gRAN_UF_SIZE, 
 			  sEQ_FRAME_SIZE, sCC_SEQ_FRAME_SIZE, gRAN_SEQ_FRAME_SIZE )
 
+import Util		( sortLt )
 import IOExts		( trace )
 \end{code}
 
@@ -242,7 +243,7 @@ Explicitly free some stack space.
 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