[project @ 2001-08-30 09:51:15 by sewardj]

Back out recent changes to the code generator as too destabilising.
Revert files as follows:

revert to 1.35   CgBindery.lhs
revert to 1.26   CgMonad.lhs
revert to 1.15   CgStackery.lhs
revert to 1.10   CgUsages.lhs

1 files changed, 59 insertions, 54 deletions

diff --git a/ghc/compiler/codeGen/CgStackery.lhs b/ghc/compiler/codeGen/CgStackery.lhs
index 89dd93ab66..26e190f1e1 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.16 2001/08/29 14:20:14 rje Exp $
+% $Id: CgStackery.lhs,v 1.17 2001/08/30 09:51:16 sewardj Exp $
 %
 \section[CgStackery]{Stack management functions}
 
@@ -141,33 +141,34 @@ allocStack :: FCode VirtualSpOffset
 allocStack = allocPrimStack 1
 
 allocPrimStack :: Int -> FCode VirtualSpOffset
-allocPrimStack size = do
-	((virt_sp, free_stk, real_sp, hw_sp),h_usage) <- getUsage
-	let push_virt_sp = virt_sp + size
-	let (chosen_slot, new_stk_usage) = 
-		case find_block free_stk of
-			Nothing -> (push_virt_sp, (push_virt_sp, free_stk, real_sp,
+allocPrimStack size info_down (MkCgState absC binds
+				 ((virt_sp, free_stk, real_sp, hw_sp), h_usage))
+  = (chosen_slot, MkCgState absC binds (new_stk_usage, h_usage))
+  where
+    push_virt_sp = virt_sp + size
+
+    (chosen_slot, new_stk_usage)
+	= case find_block free_stk of
+		Nothing -> (push_virt_sp, (push_virt_sp, free_stk, real_sp,
 				       hw_sp `max` push_virt_sp))
-						-- Adjust high water mark
-			Just slot -> (slot, (virt_sp, 
-						delete_block free_stk slot, real_sp, hw_sp))	
-	setUsage (new_stk_usage, h_usage)
-	return chosen_slot
-	
-	where
-		-- find_block looks for a contiguous chunk of free slots
-		find_block :: [(VirtualSpOffset,Slot)] -> Maybe VirtualSpOffset
-		find_block [] = Nothing
-		find_block ((off,free):slots)
-			| take size ((off,free):slots) == 
-			  zip [off..top_slot] (repeat Free) = Just top_slot
-			| otherwise				   = find_block slots
-				-- The stack grows downwards, with increasing virtual offsets.
-				-- Therefore, the address of a multi-word object is the *highest*
-				-- virtual offset it occupies (top_slot below).
-			where top_slot = off+size-1
-
-		delete_block free_stk slot = [ (s,f) | (s,f) <- free_stk, 
+				       -- Adjust high water mark
+
+		Just slot -> (slot, (virt_sp, 
+				    delete_block free_stk slot, real_sp, hw_sp))
+
+    -- find_block looks for a contiguous chunk of free slots
+    find_block :: [(VirtualSpOffset,Slot)] -> Maybe VirtualSpOffset
+    find_block [] = Nothing
+    find_block ((off,free):slots)
+      | take size ((off,free):slots) == 
+		zip [off..top_slot] (repeat Free) = Just top_slot
+      | otherwise				   = find_block slots
+	-- The stack grows downwards, with increasing virtual offsets.
+	-- Therefore, the address of a multi-word object is the *highest*
+	-- virtual offset it occupies (top_slot below).
+      where top_slot = off+size-1
+
+    delete_block free_stk slot = [ (s,f) | (s,f) <- free_stk, 
 				           (s<=slot-size) || (s>slot) ]
 			      -- Retain slots which are not in the range
 			      -- slot-size+1..slot
@@ -180,12 +181,13 @@ free list.
 
 \begin{code}
 allocStackTop :: Int -> FCode VirtualSpOffset
-allocStackTop size = do
-	((virt_sp, free_stk, real_sp, hw_sp), h_usage) <- getUsage
-	let push_virt_sp = virt_sp + size
-	let new_stk_usage = (push_virt_sp, free_stk, real_sp, hw_sp `max` push_virt_sp)
-	setUsage (new_stk_usage, h_usage)
-	return push_virt_sp
+allocStackTop size info_down (MkCgState absC binds
+	                     ((virt_sp, free_stk, real_sp, hw_sp), h_usage))
+  = (push_virt_sp, MkCgState absC binds (new_stk_usage, h_usage))
+  where
+    push_virt_sp = virt_sp + size
+    new_stk_usage = (push_virt_sp, free_stk, real_sp, hw_sp `max` push_virt_sp)
+				                -- Adjust high water mark
 \end{code}
 
 Pop some words from the current top of stack.  This is used for
@@ -193,31 +195,33 @@ de-allocating the return address in a case alternative.
 
 \begin{code}
 deAllocStackTop :: Int -> FCode VirtualSpOffset
-deAllocStackTop size = do
-	((virt_sp, free_stk, real_sp, hw_sp), h_usage) <- getUsage
-	let pop_virt_sp = virt_sp - size
-	let new_stk_usage = (pop_virt_sp, free_stk, real_sp, hw_sp)
-	setUsage (new_stk_usage, h_usage)
-	return pop_virt_sp
+deAllocStackTop size info_down (MkCgState absC binds
+	                     ((virt_sp, free_stk, real_sp, hw_sp), h_usage))
+  = (pop_virt_sp, MkCgState absC binds (new_stk_usage, h_usage))
+  where
+    pop_virt_sp = virt_sp - size
+    new_stk_usage = (pop_virt_sp, free_stk, real_sp, hw_sp)
 \end{code}
 
 \begin{code}
 adjustStackHW :: VirtualSpOffset -> Code
-adjustStackHW offset = do
-	((vSp,fSp,realSp,hwSp), h_usage) <- getUsage
-	setUsage ((vSp, fSp, realSp, max offset hwSp), h_usage)
+adjustStackHW offset info_down (MkCgState absC binds usage) 
+  = MkCgState absC binds new_usage
+  where
+    ((vSp,fSp,realSp,hwSp), h_usage) = usage
+    new_usage = ((vSp, fSp, realSp, max offset hwSp), h_usage)
+    -- No need to fiddle with virtual Sp etc because this call is
+    -- only done just before the end of a block
 \end{code}
 
 A knot-tying beast.
 
 \begin{code}
 getFinalStackHW :: (VirtualSpOffset -> Code) -> Code
-getFinalStackHW fcode = do
-	fixC (\hwSp -> do
-		fcode hwSp
-		((_,_,_, hwSp),_) <- getUsage
-		return hwSp)
-	return ()
+getFinalStackHW fcode info_down (MkCgState absC binds usages) = state1
+  where
+    state1 = fcode hwSp info_down (MkCgState absC binds usages)
+    (MkCgState _ _ ((_,_,_, hwSp), _)) = state1
 \end{code}
 
 \begin{code}
@@ -240,12 +244,13 @@ Explicitly free some stack space.
 
 \begin{code}
 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 (new_vsp, new_free) = trim vsp all_free
-	let new_usage = ((new_vsp, new_free, real, hw), heap_usage)
-	setUsage new_usage
+addFreeStackSlots extra_free slot info_down
+	state@(MkCgState abs_c binds ((vsp, free, real, hw), heap_usage))
+  = MkCgState abs_c binds new_usage
+  where
+    new_usage = ((new_vsp, new_free, real, hw), heap_usage)
+    (new_vsp, new_free) = trim vsp all_free
+    all_free = addFreeSlots free (zip extra_free (repeat slot))
 
 freeStackSlots :: [VirtualSpOffset] -> Code
 freeStackSlots slots = addFreeStackSlots slots Free