[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, 47 insertions, 49 deletions

diff --git a/ghc/compiler/codeGen/CgUsages.lhs b/ghc/compiler/codeGen/CgUsages.lhs
index 8c40c9a470..6f3353d8dd 100644
--- a/ghc/compiler/codeGen/CgUsages.lhs
+++ b/ghc/compiler/codeGen/CgUsages.lhs
@@ -39,47 +39,43 @@ heap usage.
 It is usually a prelude to performing a GC check, so everything must
 be in a tidy and consistent state.
 
-rje: Note the slightly suble fixed point behaviour needed here
 \begin{code}
 initHeapUsage :: (VirtualHeapOffset -> Code) -> Code
 
-initHeapUsage fcode = do 
-	(stk_usage, heap_usage) <- getUsage
-	setUsage (stk_usage, (0,0))
-	fixC (\heap_usage2 -> do
-		fcode (heapHWM heap_usage2)
-		(_, heap_usage2) <- getUsage
-		return heap_usage2)
-	(stk_usage2, heap_usage2) <- getUsage
-	setUsage (stk_usage2, heap_usage {-unchanged -})
+initHeapUsage fcode info_down (MkCgState absC binds (stk_usage, heap_usage))
+  = state3
+  where
+    state1 = MkCgState absC binds (stk_usage, (0, 0))
+    state2 = fcode (heapHWM heap_usage2) info_down state1
+    (MkCgState absC2 binds2 (stk_usage2, heap_usage2)) = state2
+    state3 = MkCgState  absC2
+			binds2
+			(stk_usage2, heap_usage {- unchanged -})
 \end{code}
 
 \begin{code}
 setVirtHp :: VirtualHeapOffset -> Code
-setVirtHp new_virtHp = do
-	(stk, (virtHp, realHp)) <- getUsage
-	setUsage (stk, (new_virtHp, realHp))
+setVirtHp new_virtHp info_down
+	  state@(MkCgState absC binds (stk, (virtHp, realHp)))
+  = MkCgState absC binds (stk, (new_virtHp, realHp))
 \end{code}
 
 \begin{code}
 getVirtAndRealHp :: FCode (VirtualHeapOffset, VirtualHeapOffset)
-getVirtAndRealHp = do 
-	(_, (virtHp, realHp)) <- getUsage
-	return (virtHp, realHp)
+getVirtAndRealHp info_down state@(MkCgState _ _ (_, (virtHp, realHp)))
+  = ((virtHp, realHp), state)
 \end{code}
 
 \begin{code}
 setRealHp ::  VirtualHeapOffset -> Code
-setRealHp realHp = do
-	(stk_usage, (vHp, _)) <- getUsage
-	setUsage (stk_usage, (vHp, realHp))
+setRealHp realHp info_down (MkCgState absC binds (stk_usage, (vHp, _)))
+  = MkCgState absC binds (stk_usage, (vHp, realHp))
 \end{code}
 
 \begin{code}
 getHpRelOffset :: VirtualHeapOffset -> FCode RegRelative
-getHpRelOffset virtual_offset = do
-	(_,(_,realHp)) <- getUsage
-	return $ hpRel realHp virtual_offset
+getHpRelOffset virtual_offset info_down state@(MkCgState _ _ (_,(_,realHp)))
+  = (hpRel realHp virtual_offset, state)
 \end{code}
 
 The heap high water mark is the larger of virtHp and hwHp.  The latter is
@@ -106,29 +102,27 @@ It is used to initialise things at the beginning of a closure body.
 setRealAndVirtualSp :: VirtualSpOffset 	-- New real Sp
 		     -> Code
 
-setRealAndVirtualSp sp = do
-	((vsp,f,realSp,hwsp), h_usage) <- getUsage
-	let new_usage = ((sp, f, sp, sp), h_usage)
-	setUsage new_usage
+setRealAndVirtualSp sp info_down (MkCgState absC binds
+					((vsp,f,realSp,hwsp), h_usage))
+  = MkCgState absC binds new_usage
+  where
+    new_usage = ((sp, f, sp, sp), h_usage)
 \end{code}
 
 \begin{code}
 getVirtSp :: FCode VirtualSpOffset
-getVirtSp = do 
-	((virtSp,_,_,_), _) <- getUsage
-	return virtSp
+getVirtSp info_down state@(MkCgState absC binds ((virtSp,_,_,_), _))
+  = (virtSp, state)
 
 getRealSp :: FCode VirtualSpOffset
-getRealSp = do
-	((_,_,realSp,_),_) <- getUsage
-	return realSp
+getRealSp info_down state@(MkCgState absC binds ((_,_,realSp,_),_)) 
+  = (realSp,state)
 \end{code}
 
 \begin{code}
 getSpRelOffset :: VirtualSpOffset -> FCode RegRelative
-getSpRelOffset virtual_offset = do
-	((_,_,realSp,_),_) <- getUsage
-  	return $ spRel realSp virtual_offset
+getSpRelOffset virtual_offset info_down state@(MkCgState _ _ ((_,_,realSp,_),_))
+  = (spRel realSp virtual_offset, state)
 \end{code}
 
 %************************************************************************
@@ -150,21 +144,25 @@ That's done by functions which allocate stack space.
 \begin{code}
 adjustSpAndHp :: VirtualSpOffset 	-- New offset for Arg stack ptr
 	      -> Code
-adjustSpAndHp newRealSp = do
-	(MkCgInfoDown _ _ _ ticky_ctr _) <- getInfoDown
-	(MkCgState absC binds
-		   ((vSp,fSp,realSp,hwSp),	
-		   (vHp, rHp))) <- getState
-	let move_sp = if (newRealSp == realSp) then AbsCNop
+adjustSpAndHp newRealSp (MkCgInfoDown _ _ _ ticky_ctr _)
+			(MkCgState absC binds
+				   ((vSp,fSp,realSp,hwSp),	
+				   (vHp, rHp)))
+  = MkCgState (mkAbstractCs [absC,move_sp,move_hp]) binds new_usage
+    where
+
+    move_sp = if (newRealSp == realSp) then AbsCNop
 	      else (CAssign (CReg Sp)
 			    (CAddr (spRel realSp newRealSp)))
-	let move_hp = 
-		if (rHp == vHp) then AbsCNop
-	 	else mkAbstractCs [
-		CAssign (CReg Hp) (CAddr (hpRel rHp vHp)),
+
+	-- Adjust the heap pointer backwards in case we over-allocated
+	-- Analogously, we also remove bytes from the ticky counter
+    move_hp = if (rHp == vHp) then AbsCNop
+	      else mkAbstractCs [
+			CAssign (CReg Hp) (CAddr (hpRel rHp vHp)),
 			profCtrAbsC SLIT("TICK_ALLOC_HEAP") 
-			[ mkIntCLit (vHp - rHp), CLbl ticky_ctr DataPtrRep ]
-		]
-	let new_usage = ((vSp, fSp, newRealSp, hwSp), (vHp,vHp))
-	setState $ MkCgState (mkAbstractCs [absC,move_sp,move_hp]) binds new_usage
+			    [ mkIntCLit (vHp - rHp), CLbl ticky_ctr DataPtrRep ]
+	      ]
+
+    new_usage = ((vSp, fSp, newRealSp, hwSp), (vHp,vHp))
 \end{code}