Merge remote-tracking branch 'origin/master' into newcg

Conflicts:
	compiler/cmm/CmmLint.hs
	compiler/cmm/OldCmm.hs
	compiler/codeGen/CgMonad.lhs
	compiler/main/CodeOutput.lhs

17 files changed, 1258 insertions, 1216 deletions

diff --git a/compiler/codeGen/CgBindery.lhs b/compiler/codeGen/CgBindery.lhs
index 65f8a52981..198e192f5c 100644
--- a/compiler/codeGen/CgBindery.lhs
+++ b/compiler/codeGen/CgBindery.lhs
@@ -5,37 +5,31 @@
 \section[CgBindery]{Utility functions related to doing @CgBindings@}
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
 
 module CgBindery (
-	CgBindings, CgIdInfo,
-	StableLoc, VolatileLoc,
+        CgBindings, CgIdInfo,
+        StableLoc, VolatileLoc,
 
-	cgIdInfoId, cgIdInfoArgRep, cgIdInfoLF,
+        cgIdInfoId, cgIdInfoArgRep, cgIdInfoLF,
 
-	stableIdInfo, heapIdInfo,
+        stableIdInfo, heapIdInfo,
         taggedStableIdInfo, taggedHeapIdInfo,
-	letNoEscapeIdInfo, idInfoToAmode,
+        letNoEscapeIdInfo, idInfoToAmode,
 
-	addBindC, addBindsC,
+        addBindC, addBindsC,
 
-	nukeVolatileBinds,
-	nukeDeadBindings,
-	getLiveStackSlots,
+        nukeVolatileBinds,
+        nukeDeadBindings,
+        getLiveStackSlots,
         getLiveStackBindings,
 
-	bindArgsToStack,  rebindToStack,
-	bindNewToNode, bindNewToUntagNode, bindNewToReg, bindArgsToRegs,
-	bindNewToTemp,
-	getArgAmode, getArgAmodes, 
-	getCgIdInfo, 
-	getCAddrModeIfVolatile, getVolatileRegs,
-	maybeLetNoEscape, 
+        bindArgsToStack,  rebindToStack,
+        bindNewToNode, bindNewToUntagNode, bindNewToReg, bindArgsToRegs,
+        bindNewToTemp,
+        getArgAmode, getArgAmodes, 
+        getCgIdInfo, 
+        getCAddrModeIfVolatile, getVolatileRegs,
+        maybeLetNoEscape, 
     ) where
 
 import CgMonad
@@ -47,7 +41,7 @@ import ClosureInfo
 import Constants
 
 import OldCmm
-import PprCmm		( {- instance Outputable -} )
+import PprCmm           ( {- instance Outputable -} )
 import SMRep
 import Id
 import DataCon
@@ -64,40 +58,39 @@ import FastString
 
 \end{code}
 
-
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[Bindery-datatypes]{Data types}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 @(CgBinding a b)@ is a type of finite maps from a to b.
 
 The assumption used to be that @lookupCgBind@ must get exactly one
-match.  This is {\em completely wrong} in the case of compiling
-letrecs (where knot-tying is used).  An initial binding is fed in (and
+match. This is {\em completely wrong} in the case of compiling
+letrecs (where knot-tying is used). An initial binding is fed in (and
 never evaluated); eventually, a correct binding is put into the
-environment.  So there can be two bindings for a given name.
+environment. So there can be two bindings for a given name.
 
 \begin{code}
 type CgBindings = IdEnv CgIdInfo
 
 data CgIdInfo
-  = CgIdInfo	
-	{ cg_id :: Id	-- Id that this is the info for
-			-- Can differ from the Id at occurrence sites by 
-			-- virtue of being externalised, for splittable C
-	, cg_rep :: CgRep
-	, cg_vol :: VolatileLoc
-	, cg_stb :: StableLoc
-	, cg_lf  :: LambdaFormInfo 
+  = CgIdInfo    
+        { cg_id :: Id   -- Id that this is the info for
+                        -- Can differ from the Id at occurrence sites by 
+                        -- virtue of being externalised, for splittable C
+        , cg_rep :: CgRep
+        , cg_vol :: VolatileLoc
+        , cg_stb :: StableLoc
+        , cg_lf  :: LambdaFormInfo 
         , cg_tag :: {-# UNPACK #-} !Int  -- tag to be added in idInfoToAmode
          }
 
 mkCgIdInfo :: Id -> VolatileLoc -> StableLoc -> LambdaFormInfo -> CgIdInfo
 mkCgIdInfo id vol stb lf
   = CgIdInfo { cg_id = id, cg_vol = vol, cg_stb = stb, 
-	       cg_lf = lf, cg_rep = idCgRep id, cg_tag = tag }
+               cg_lf = lf, cg_rep = idCgRep id, cg_tag = tag }
   where
     tag
       | Just con <- isDataConWorkId_maybe id,
@@ -114,16 +107,16 @@ mkCgIdInfo id vol stb lf
 
 voidIdInfo :: Id -> CgIdInfo
 voidIdInfo id = CgIdInfo { cg_id = id, cg_vol = NoVolatileLoc
-			 , cg_stb = VoidLoc, cg_lf = mkLFArgument id
-			 , cg_rep = VoidArg, cg_tag = 0 }
-	-- Used just for VoidRep things
+                         , cg_stb = VoidLoc, cg_lf = mkLFArgument id
+                         , cg_rep = VoidArg, cg_tag = 0 }
+        -- Used just for VoidRep things
 
-data VolatileLoc	-- These locations die across a call
+data VolatileLoc        -- These locations die across a call
   = NoVolatileLoc
-  | RegLoc	CmmReg		   -- In one of the registers (global or local)
-  | VirHpLoc	VirtualHpOffset  -- Hp+offset (address of closure)
-  | VirNodeLoc	ByteOff            -- Cts of offset indirect from Node
-				   -- ie *(Node+offset).
+  | RegLoc      CmmReg             -- In one of the registers (global or local)
+  | VirHpLoc    VirtualHpOffset  -- Hp+offset (address of closure)
+  | VirNodeLoc  ByteOff            -- Cts of offset indirect from Node
+                                   -- ie *(Node+offset).
                                    -- NB. Byte offset, because we subtract R1's
                                    -- tag from the offset.
 
@@ -131,7 +124,7 @@ mkTaggedCgIdInfo :: Id -> VolatileLoc -> StableLoc -> LambdaFormInfo -> DataCon
                  -> CgIdInfo
 mkTaggedCgIdInfo id vol stb lf con
   = CgIdInfo { cg_id = id, cg_vol = vol, cg_stb = stb, 
-	       cg_lf = lf, cg_rep = idCgRep id, cg_tag = tagForCon con }
+               cg_lf = lf, cg_rep = idCgRep id, cg_tag = tagForCon con }
 \end{code}
 
 @StableLoc@ encodes where an Id can be found, used by
@@ -141,20 +134,18 @@ the @CgBindings@ environment in @CgBindery@.
 data StableLoc
   = NoStableLoc
 
-  | VirStkLoc	VirtualSpOffset		-- The thing is held in this
-					-- stack slot
+  | VirStkLoc   VirtualSpOffset         -- The thing is held in this
+                                        -- stack slot
 
-  | VirStkLNE	VirtualSpOffset		-- A let-no-escape thing; the
-					-- value is this stack pointer
-					-- (as opposed to the contents of the slot)
+  | VirStkLNE   VirtualSpOffset         -- A let-no-escape thing; the
+                                        -- value is this stack pointer
+                                        -- (as opposed to the contents of the slot)
 
-  | StableLoc	CmmExpr
-  | VoidLoc	-- Used only for VoidRep variables.  They never need to
-		-- be saved, so it makes sense to treat treat them as
-		-- having a stable location
-\end{code}
+  | StableLoc   CmmExpr
+  | VoidLoc     -- Used only for VoidRep variables.  They never need to
+                -- be saved, so it makes sense to treat treat them as
+                -- having a stable location
 
-\begin{code}
 instance PlatformOutputable CgIdInfo where
   pprPlatform platform (CgIdInfo id _ vol stb _ _)
     -- TODO, pretty pring the tag info
@@ -175,9 +166,9 @@ instance PlatformOutputable StableLoc where
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[Bindery-idInfo]{Manipulating IdInfo}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -191,7 +182,7 @@ letNoEscapeIdInfo :: Id -> VirtualSpOffset -> LambdaFormInfo -> CgIdInfo
 letNoEscapeIdInfo id sp lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLNE sp) lf_info
 
 stackIdInfo :: Id -> VirtualSpOffset -> LambdaFormInfo -> CgIdInfo
-stackIdInfo id sp	lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLoc sp) lf_info
+stackIdInfo id sp       lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLoc sp) lf_info
 
 nodeIdInfo :: Id -> Int -> LambdaFormInfo -> CgIdInfo
 nodeIdInfo id offset    lf_info = mkCgIdInfo id (VirNodeLoc (wORD_SIZE*offset)) NoStableLoc lf_info
@@ -216,7 +207,7 @@ untagNodeIdInfo id offset    lf_info tag
 idInfoToAmode :: CgIdInfo -> FCode CmmExpr
 idInfoToAmode info
   = case cg_vol info of {
-      RegLoc reg 	-> returnFC (CmmReg reg) ;
+      RegLoc reg        -> returnFC (CmmReg reg) ;
       VirNodeLoc nd_off -> returnFC (CmmLoad (cmmOffsetB (CmmReg nodeReg) nd_off)
                                              mach_rep) ;
       VirHpLoc hp_off   -> do { off <- getHpRelOffset hp_off
@@ -226,14 +217,14 @@ idInfoToAmode info
     case cg_stb info of
       StableLoc amode  -> returnFC $! maybeTag amode
       VirStkLoc sp_off -> do { sp_rel <- getSpRelOffset sp_off
-			     ; return (CmmLoad sp_rel mach_rep) }
+                             ; return (CmmLoad sp_rel mach_rep) }
 
       VirStkLNE sp_off -> getSpRelOffset sp_off
 
       VoidLoc -> return $ pprPanic "idInfoToAmode: void" (ppr (cg_id info))
-		-- We return a 'bottom' amode, rather than panicing now
-		-- In this way getArgAmode returns a pair of (VoidArg, bottom)
-		-- and that's exactly what we want
+                -- We return a 'bottom' amode, rather than panicing now
+                -- In this way getArgAmode returns a pair of (VoidArg, bottom)
+                -- and that's exactly what we want
 
       NoStableLoc -> pprPanic "idInfoToAmode: no loc" (ppr (cg_id info))
     }
@@ -256,16 +247,16 @@ cgIdInfoArgRep = cg_rep
 
 maybeLetNoEscape :: CgIdInfo -> Maybe VirtualSpOffset
 maybeLetNoEscape (CgIdInfo { cg_stb = VirStkLNE sp_off }) = Just sp_off
-maybeLetNoEscape _       				  = Nothing
+maybeLetNoEscape _                                        = Nothing
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[CgMonad-bindery]{Monad things for fiddling with @CgBindings@}
-%*									*
+%*                                                                      *
 %************************************************************************
 
-.There are three basic routines, for adding (@addBindC@), modifying
+There are three basic routines, for adding (@addBindC@), modifying
 (@modifyBindC@) and looking up (@getCgIdInfo@) bindings.
 
 A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple.
@@ -274,72 +265,72 @@ The name should not already be bound. (nice ASSERT, eh?)
 \begin{code}
 addBindC :: Id -> CgIdInfo -> Code
 addBindC name stuff_to_bind = do
-	binds <- getBinds
-	setBinds $ extendVarEnv binds name stuff_to_bind
+        binds <- getBinds
+        setBinds $ extendVarEnv binds name stuff_to_bind
 
 addBindsC :: [(Id, CgIdInfo)] -> Code
 addBindsC new_bindings = do
-	binds <- getBinds
-	let new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
-			      binds
-			      new_bindings
-	setBinds new_binds
+        binds <- getBinds
+        let new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
+                              binds
+                              new_bindings
+        setBinds new_binds
 
 modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code
 modifyBindC name mangle_fn = do
-	binds <- getBinds
-	setBinds $ modifyVarEnv mangle_fn binds name
+        binds <- getBinds
+        setBinds $ modifyVarEnv mangle_fn binds name
 
 getCgIdInfo :: Id -> FCode CgIdInfo
 getCgIdInfo id
-  = do	{ 	-- Try local bindings first
-	; local_binds  <- getBinds
-	; case lookupVarEnv local_binds id of {
-	    Just info -> return info ;
-	    Nothing   -> do
-
-	{ 	-- Try top-level bindings
-	  static_binds <- getStaticBinds
-	; case lookupVarEnv static_binds id of {
-	    Just info -> return info ;
-	    Nothing   ->
-
-		-- Should be imported; make up a CgIdInfo for it
-	let 
-	    name = idName id
-	in
-	if isExternalName name then do
-	    let ext_lbl = CmmLit (CmmLabel (mkClosureLabel name $ idCafInfo id))
-	    return (stableIdInfo id ext_lbl (mkLFImported id))
-	else
-	if isVoidArg (idCgRep id) then
-		-- Void things are never in the environment
-	    return (voidIdInfo id)
-	else
-	-- Bug	
-	cgLookupPanic id
-	}}}}
+  = do  {       -- Try local bindings first
+        ; local_binds  <- getBinds
+        ; case lookupVarEnv local_binds id of {
+            Just info -> return info ;
+            Nothing   -> do
+
+        {       -- Try top-level bindings
+          static_binds <- getStaticBinds
+        ; case lookupVarEnv static_binds id of {
+            Just info -> return info ;
+            Nothing   ->
+
+                -- Should be imported; make up a CgIdInfo for it
+        let 
+            name = idName id
+        in
+        if isExternalName name then do
+            let ext_lbl = CmmLit (CmmLabel (mkClosureLabel name $ idCafInfo id))
+            return (stableIdInfo id ext_lbl (mkLFImported id))
+        else
+        if isVoidArg (idCgRep id) then
+                -- Void things are never in the environment
+            return (voidIdInfo id)
+        else
+        -- Bug  
+        cgLookupPanic id
+        }}}}
     
-			
+                        
 cgLookupPanic :: Id -> FCode a
 cgLookupPanic id
-  = do	static_binds <- getStaticBinds
-	local_binds <- getBinds
+  = do  static_binds <- getStaticBinds
+        local_binds <- getBinds
 --      srt <- getSRTLabel
         pprPanic "cgLookupPanic (probably invalid Core; try -dcore-lint)"
-		(vcat [ppr id,
-		ptext (sLit "static binds for:"),
-		vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
-		ptext (sLit "local binds for:"),
+                (vcat [ppr id,
+                ptext (sLit "static binds for:"),
+                vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
+                ptext (sLit "local binds for:"),
                 vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ]
 --              ptext (sLit "SRT label") <+> pprCLabel srt
-	      ])
+              ])
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 We sometimes want to nuke all the volatile bindings; we must be sure
@@ -357,71 +348,68 @@ nukeVolatileBinds binds
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[lookup-interface]{Interface functions to looking up bindings}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
 getCAddrModeIfVolatile :: Id -> FCode (Maybe CmmExpr)
 getCAddrModeIfVolatile id
-  = do	{ info <- getCgIdInfo id
-	; case cg_stb info of
-		NoStableLoc -> do -- Aha!  So it is volatile!
-			amode <- idInfoToAmode info
-			return $ Just amode
-		_ -> return Nothing }
+  = do  { info <- getCgIdInfo id
+        ; case cg_stb info of
+                NoStableLoc -> do -- Aha!  So it is volatile!
+                        amode <- idInfoToAmode info
+                        return $ Just amode
+                _ -> return Nothing }
 \end{code}
 
 @getVolatileRegs@ gets a set of live variables, and returns a list of
-all registers on which these variables depend.  These are the regs
-which must be saved and restored across any C calls.  If a variable is
+all registers on which these variables depend. These are the regs
+which must be saved and restored across any C calls. If a variable is
 both in a volatile location (depending on a register) {\em and} a
 stable one (notably, on the stack), we modify the current bindings to
 forget the volatile one.
 
 \begin{code}
 getVolatileRegs :: StgLiveVars -> FCode [GlobalReg]
-
 getVolatileRegs vars = do
-  do 	{ stuff <- mapFCs snaffle_it (varSetElems vars)
-	; returnFC $ catMaybes stuff }
+  do    { stuff <- mapFCs snaffle_it (varSetElems vars)
+        ; returnFC $ catMaybes stuff }
   where
     snaffle_it var = do
-	{ info <- getCgIdInfo var 
-	; let
-		-- commoned-up code...
-	     consider_reg reg
-		=	-- We assume that all regs can die across C calls
-			-- We leave it to the save-macros to decide which
-			-- regs *really* need to be saved.
-		  case cg_stb info of
-			NoStableLoc     -> returnFC (Just reg) -- got one!
-			_ -> do
-				{ -- has both volatile & stable locations;
-				  -- force it to rely on the stable location
-				  modifyBindC var nuke_vol_bind 
-				; return Nothing }
-
-	; case cg_vol info of
-	    RegLoc (CmmGlobal reg) -> consider_reg reg
-	    VirNodeLoc _ 	   -> consider_reg node
-	    _         	 	   -> returnFC Nothing	-- Local registers
-	}
+        { info <- getCgIdInfo var 
+        ; let
+                -- commoned-up code...
+             consider_reg reg
+                =       -- We assume that all regs can die across C calls
+                        -- We leave it to the save-macros to decide which
+                        -- regs *really* need to be saved.
+                  case cg_stb info of
+                        NoStableLoc     -> returnFC (Just reg) -- got one!
+                        _ -> do
+                                { -- has both volatile & stable locations;
+                                  -- force it to rely on the stable location
+                                  modifyBindC var nuke_vol_bind 
+                                ; return Nothing }
+
+        ; case cg_vol info of
+            RegLoc (CmmGlobal reg) -> consider_reg reg
+            VirNodeLoc _           -> consider_reg node
+            _                      -> returnFC Nothing  -- Local registers
+        }
 
     nuke_vol_bind info = info { cg_vol = NoVolatileLoc }
-\end{code}
 
-\begin{code}
 getArgAmode :: StgArg -> FCode (CgRep, CmmExpr)
 getArgAmode (StgVarArg var) 
-  = do	{ info <- getCgIdInfo var
-	; amode <- idInfoToAmode info
-	; return (cgIdInfoArgRep info, amode ) }
+  = do  { info <- getCgIdInfo var
+        ; amode <- idInfoToAmode info
+        ; return (cgIdInfoArgRep info, amode ) }
 
 getArgAmode (StgLitArg lit) 
-  = do	{ cmm_lit <- cgLit lit
-	; return (typeCgRep (literalType lit), CmmLit cmm_lit) }
+  = do  { cmm_lit <- cgLit lit
+        ; return (typeCgRep (literalType lit), CmmLit cmm_lit) }
 
 getArgAmode (StgTypeArg _) = panic "getArgAmode: type arg"
 
@@ -429,15 +417,15 @@ getArgAmodes :: [StgArg] -> FCode [(CgRep, CmmExpr)]
 getArgAmodes [] = returnFC []
 getArgAmodes (atom:atoms)
   | isStgTypeArg atom = getArgAmodes atoms
-  | otherwise 	      = do { amode  <- getArgAmode  atom 
-	 		   ; amodes <- getArgAmodes atoms
-	 		   ; return ( amode : amodes ) }
+  | otherwise         = do { amode  <- getArgAmode  atom 
+                           ; amodes <- getArgAmodes atoms
+                           ; return ( amode : amodes ) }
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[binding-and-rebinding-interface]{Interface functions for binding and re-binding names}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -466,22 +454,20 @@ bindNewToUntagNode id offset lf_info tag
 -- temporary.
 bindNewToTemp :: Id -> FCode LocalReg
 bindNewToTemp id
-  = do	addBindC id (regIdInfo id (CmmLocal temp_reg) lf_info)
-	return temp_reg
+  = do  addBindC id (regIdInfo id (CmmLocal temp_reg) lf_info)
+        return temp_reg
   where
     uniq     = getUnique id
     temp_reg = LocalReg uniq (argMachRep (idCgRep id))
-    lf_info  = mkLFArgument id	-- Always used of things we
-				-- know nothing about
+    lf_info  = mkLFArgument id  -- Always used of things we
+                                -- know nothing about
 
 bindNewToReg :: Id -> CmmReg -> LambdaFormInfo -> Code
 bindNewToReg name reg lf_info
   = addBindC name info
   where
     info = mkCgIdInfo name (RegLoc reg) NoStableLoc lf_info
-\end{code}
 
-\begin{code}
 rebindToStack :: Id -> VirtualSpOffset -> Code
 rebindToStack name offset
   = modifyBindC name replace_stable_fn
@@ -490,19 +476,19 @@ rebindToStack name offset
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[CgMonad-deadslots]{Finding dead stack slots}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 nukeDeadBindings does the following:
 
-      -	Removes all bindings from the environment other than those
-	for variables in the argument to nukeDeadBindings.
-      -	Collects any stack slots so freed, and returns them to the  stack free
-	list.
-      -	Moves the virtual stack pointer to point to the topmost used
-	stack locations.
+      - Removes all bindings from the environment other than those
+        for variables in the argument to nukeDeadBindings.
+      - Collects any stack slots so freed, and returns them to the  stack free
+        list.
+      - Moves the virtual stack pointer to point to the topmost used
+        stack locations.
 
 You can have multi-word slots on the stack (where a Double# used to
 be, for instance); if dead, such a slot will be reported as *several*
@@ -512,60 +498,56 @@ Probably *naughty* to look inside monad...
 
 \begin{code}
 nukeDeadBindings :: StgLiveVars  -- All the *live* variables
-		 -> Code
+                 -> Code
 nukeDeadBindings live_vars = do
-	binds <- getBinds
-	let (dead_stk_slots, bs') =
-		dead_slots live_vars 
-			[] []
-			[ (cg_id b, b) | b <- varEnvElts binds ]
-	setBinds $ mkVarEnv bs'
-	freeStackSlots dead_stk_slots
+        binds <- getBinds
+        let (dead_stk_slots, bs') =
+                dead_slots live_vars 
+                        [] []
+                        [ (cg_id b, b) | b <- varEnvElts binds ]
+        setBinds $ mkVarEnv bs'
+        freeStackSlots dead_stk_slots
 \end{code}
 
 Several boring auxiliary functions to do the dirty work.
 
 \begin{code}
 dead_slots :: StgLiveVars
-	   -> [(Id,CgIdInfo)]
-	   -> [VirtualSpOffset]
-	   -> [(Id,CgIdInfo)]
-	   -> ([VirtualSpOffset], [(Id,CgIdInfo)])
+           -> [(Id,CgIdInfo)]
+           -> [VirtualSpOffset]
+           -> [(Id,CgIdInfo)]
+           -> ([VirtualSpOffset], [(Id,CgIdInfo)])
 
 -- dead_slots carries accumulating parameters for
---	filtered bindings, dead slots
+--      filtered bindings, dead slots
 dead_slots _ fbs ds []
   = (ds, reverse fbs) -- Finished; rm the dups, if any
 
 dead_slots live_vars fbs ds ((v,i):bs)
   | v `elementOfUniqSet` live_vars
     = dead_slots live_vars ((v,i):fbs) ds bs
-	  -- Live, so don't record it in dead slots
-	  -- Instead keep it in the filtered bindings
+          -- Live, so don't record it in dead slots
+          -- Instead keep it in the filtered bindings
 
   | otherwise
     = case cg_stb i of
-	VirStkLoc offset
-	 | size > 0
-	 -> dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
+        VirStkLoc offset
+         | size > 0
+         -> dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
 
-	_ -> dead_slots live_vars fbs ds bs
+        _ -> dead_slots live_vars fbs ds bs
   where
     size :: WordOff
     size = cgRepSizeW (cg_rep i)
-\end{code}
 
-\begin{code}
 getLiveStackSlots :: FCode [VirtualSpOffset]
 -- Return the offsets of slots in stack containig live pointers
 getLiveStackSlots 
-  = do 	{ binds <- getBinds
-	; return [off | CgIdInfo { cg_stb = VirStkLoc off, 
-				   cg_rep = rep } <- varEnvElts binds, 
-		        isFollowableArg rep] }
-\end{code}
+  = do  { binds <- getBinds
+        ; return [off | CgIdInfo { cg_stb = VirStkLoc off, 
+                                   cg_rep = rep } <- varEnvElts binds, 
+                        isFollowableArg rep] }
 
-\begin{code}
 getLiveStackBindings :: FCode [(VirtualSpOffset, CgIdInfo)]
 getLiveStackBindings
   = do { binds <- getBinds
@@ -575,3 +557,4 @@ getLiveStackBindings
                             cg_rep = rep} <- [bind],
                  isFollowableArg rep] }
 \end{code}
+
diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs
index 0a3911ea82..c65194b62f 100644
--- a/compiler/codeGen/CgCallConv.hs
+++ b/compiler/codeGen/CgCallConv.hs
@@ -4,34 +4,27 @@
 --
 -- CgCallConv
 --
--- The datatypes and functions here encapsulate the 
+-- The datatypes and functions here encapsulate the
 -- calling and return conventions used by the code generator.
 --
 -----------------------------------------------------------------------------
 
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module CgCallConv (
-	-- Argument descriptors
-	mkArgDescr, 
+        -- Argument descriptors
+        mkArgDescr,
 
-	-- Liveness
-	mkRegLiveness, 
+        -- Liveness
+        mkRegLiveness,
 
-	-- Register assignment
-	assignCallRegs, assignReturnRegs, assignPrimOpCallRegs,
+        -- Register assignment
+        assignCallRegs, assignReturnRegs, assignPrimOpCallRegs,
 
-	-- Calls
-	constructSlowCall, slowArgs, slowCallPattern,
+        -- Calls
+        constructSlowCall, slowArgs, slowCallPattern,
 
-	-- Returns
-	dataReturnConvPrim,
-	getSequelAmode
+        -- Returns
+        dataReturnConvPrim,
+        getSequelAmode
     ) where
 
 import CgMonad
@@ -57,11 +50,11 @@ import Data.Bits
 
 -------------------------------------------------------------------------
 --
---	Making argument descriptors
+--      Making argument descriptors
 --
 --  An argument descriptor describes the layout of args on the stack,
---  both for 	* GC (stack-layout) purposes, and 
---		* saving/restoring registers when a heap-check fails
+--  both for    * GC (stack-layout) purposes, and
+--              * saving/restoring registers when a heap-check fails
 --
 -- Void arguments aren't important, therefore (contrast constructSlowCall)
 --
@@ -72,29 +65,29 @@ import Data.Bits
 
 -------------------------
 mkArgDescr :: Name -> [Id] -> FCode ArgDescr
-mkArgDescr _nm args 
+mkArgDescr _nm args
   = case stdPattern arg_reps of
-	Just spec_id -> return (ArgSpec spec_id)
-	Nothing      -> return (ArgGen arg_bits)
+        Just spec_id -> return (ArgSpec spec_id)
+        Nothing      -> return (ArgGen arg_bits)
   where
     arg_bits = argBits arg_reps
     arg_reps = filter nonVoidArg (map idCgRep args)
-	-- Getting rid of voids eases matching of standard patterns
+        -- Getting rid of voids eases matching of standard patterns
 
-argBits :: [CgRep] -> [Bool]	-- True for non-ptr, False for ptr
-argBits [] 		= []
+argBits :: [CgRep] -> [Bool]    -- True for non-ptr, False for ptr
+argBits []              = []
 argBits (PtrArg : args) = False : argBits args
 argBits (arg    : args) = take (cgRepSizeW arg) (repeat True) ++ argBits args
 
 stdPattern :: [CgRep] -> Maybe StgHalfWord
-stdPattern []          = Just ARG_NONE	-- just void args, probably
+stdPattern []          = Just ARG_NONE  -- just void args, probably
 
 stdPattern [PtrArg]    = Just ARG_P
 stdPattern [FloatArg]  = Just ARG_F
 stdPattern [DoubleArg] = Just ARG_D
 stdPattern [LongArg]   = Just ARG_L
 stdPattern [NonPtrArg] = Just ARG_N
-	 
+
 stdPattern [NonPtrArg,NonPtrArg] = Just ARG_NN
 stdPattern [NonPtrArg,PtrArg]    = Just ARG_NP
 stdPattern [PtrArg,NonPtrArg]    = Just ARG_PN
@@ -103,13 +96,13 @@ stdPattern [PtrArg,PtrArg]       = Just ARG_PP
 stdPattern [NonPtrArg,NonPtrArg,NonPtrArg] = Just ARG_NNN
 stdPattern [NonPtrArg,NonPtrArg,PtrArg]    = Just ARG_NNP
 stdPattern [NonPtrArg,PtrArg,NonPtrArg]    = Just ARG_NPN
-stdPattern [NonPtrArg,PtrArg,PtrArg]	   = Just ARG_NPP
+stdPattern [NonPtrArg,PtrArg,PtrArg]       = Just ARG_NPP
 stdPattern [PtrArg,NonPtrArg,NonPtrArg]    = Just ARG_PNN
-stdPattern [PtrArg,NonPtrArg,PtrArg]	   = Just ARG_PNP
-stdPattern [PtrArg,PtrArg,NonPtrArg]	   = Just ARG_PPN
-stdPattern [PtrArg,PtrArg,PtrArg]	   = Just ARG_PPP
-	 
-stdPattern [PtrArg,PtrArg,PtrArg,PtrArg]	       = Just ARG_PPPP
+stdPattern [PtrArg,NonPtrArg,PtrArg]       = Just ARG_PNP
+stdPattern [PtrArg,PtrArg,NonPtrArg]       = Just ARG_PPN
+stdPattern [PtrArg,PtrArg,PtrArg]          = Just ARG_PPP
+
+stdPattern [PtrArg,PtrArg,PtrArg,PtrArg]               = Just ARG_PPPP
 stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg]        = Just ARG_PPPPP
 stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg,PtrArg] = Just ARG_PPPPPP
 stdPattern _ = Nothing
@@ -117,17 +110,17 @@ stdPattern _ = Nothing
 
 -------------------------------------------------------------------------
 --
---		Bitmap describing register liveness
---		across GC when doing a "generic" heap check
---		(a RET_DYN stack frame).
+--              Bitmap describing register liveness
+--              across GC when doing a "generic" heap check
+--              (a RET_DYN stack frame).
 --
--- NB. Must agree with these macros (currently in StgMacros.h): 
+-- NB. Must agree with these macros (currently in StgMacros.h):
 -- GET_NON_PTRS(), GET_PTRS(), GET_LIVENESS().
 -------------------------------------------------------------------------
 
 mkRegLiveness :: [(Id, GlobalReg)] -> Int -> Int -> StgWord
 mkRegLiveness regs ptrs nptrs
-  = (fromIntegral nptrs `shiftL` 16) .|. 
+  = (fromIntegral nptrs `shiftL` 16) .|.
     (fromIntegral ptrs  `shiftL` 24) .|.
     all_non_ptrs `xor` reg_bits regs
   where
@@ -135,31 +128,31 @@ mkRegLiveness regs ptrs nptrs
 
     reg_bits [] = 0
     reg_bits ((id, VanillaReg i _) : regs) | isFollowableArg (idCgRep id)
-  	= (1 `shiftL` (i - 1)) .|. reg_bits regs
+        = (1 `shiftL` (i - 1)) .|. reg_bits regs
     reg_bits (_ : regs)
-	= reg_bits regs
-  
+        = reg_bits regs
+
 -------------------------------------------------------------------------
 --
---		Pushing the arguments for a slow call
+--              Pushing the arguments for a slow call
 --
 -------------------------------------------------------------------------
 
 -- For a slow call, we must take a bunch of arguments and intersperse
 -- some stg_ap_<pattern>_ret_info return addresses.
 constructSlowCall
-	:: [(CgRep,CmmExpr)]
-	-> (CLabel,		-- RTS entry point for call
-	   [(CgRep,CmmExpr)],	-- args to pass to the entry point
-	   [(CgRep,CmmExpr)])	-- stuff to save on the stack
+        :: [(CgRep,CmmExpr)]
+        -> (CLabel,             -- RTS entry point for call
+           [(CgRep,CmmExpr)],   -- args to pass to the entry point
+           [(CgRep,CmmExpr)])   -- stuff to save on the stack
 
    -- don't forget the zero case
-constructSlowCall [] 
+constructSlowCall []
   = (mkRtsApFastLabel (fsLit "stg_ap_0"), [], [])
 
 constructSlowCall amodes
   = (stg_ap_pat, these, rest)
-  where 
+  where
     stg_ap_pat = mkRtsApFastLabel arg_pat
     (arg_pat, these, rest) = matchSlowPattern amodes
 
@@ -178,33 +171,33 @@ slowArgs amodes
     save_cccs  = [(NonPtrArg, mkLblExpr save_cccs_lbl), (NonPtrArg, curCCS)]
     save_cccs_lbl = mkCmmRetInfoLabel rtsPackageId (fsLit "stg_restore_cccs")
 
-matchSlowPattern :: [(CgRep,CmmExpr)] 
-		 -> (FastString, [(CgRep,CmmExpr)], [(CgRep,CmmExpr)])
+matchSlowPattern :: [(CgRep,CmmExpr)]
+                 -> (FastString, [(CgRep,CmmExpr)], [(CgRep,CmmExpr)])
 matchSlowPattern amodes = (arg_pat, these, rest)
   where (arg_pat, n)  = slowCallPattern (map fst amodes)
-	(these, rest) = splitAt n amodes
+        (these, rest) = splitAt n amodes
 
 -- These cases were found to cover about 99% of all slow calls:
 slowCallPattern :: [CgRep] -> (FastString, Int)
 slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_pppppp", 6)
-slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) 	    = (fsLit "stg_ap_ppppp", 5)
-slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: _) 	= (fsLit "stg_ap_pppp", 4)
-slowCallPattern (PtrArg: PtrArg: PtrArg: VoidArg: _) 	= (fsLit "stg_ap_pppv", 4)
-slowCallPattern (PtrArg: PtrArg: PtrArg: _)       	= (fsLit "stg_ap_ppp", 3)
-slowCallPattern (PtrArg: PtrArg: VoidArg: _)       	= (fsLit "stg_ap_ppv", 3)
-slowCallPattern (PtrArg: PtrArg: _)			= (fsLit "stg_ap_pp", 2)
-slowCallPattern (PtrArg: VoidArg: _)			= (fsLit "stg_ap_pv", 2)
-slowCallPattern (PtrArg: _)				= (fsLit "stg_ap_p", 1)
-slowCallPattern (VoidArg: _)				= (fsLit "stg_ap_v", 1)
-slowCallPattern (NonPtrArg: _)				= (fsLit "stg_ap_n", 1)
-slowCallPattern (FloatArg: _)				= (fsLit "stg_ap_f", 1)
-slowCallPattern (DoubleArg: _)				= (fsLit "stg_ap_d", 1)
-slowCallPattern (LongArg: _)				= (fsLit "stg_ap_l", 1)
-slowCallPattern _ 					= panic "CgStackery.slowCallPattern"
+slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _)         = (fsLit "stg_ap_ppppp", 5)
+slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: _)     = (fsLit "stg_ap_pppp", 4)
+slowCallPattern (PtrArg: PtrArg: PtrArg: VoidArg: _)    = (fsLit "stg_ap_pppv", 4)
+slowCallPattern (PtrArg: PtrArg: PtrArg: _)             = (fsLit "stg_ap_ppp", 3)
+slowCallPattern (PtrArg: PtrArg: VoidArg: _)            = (fsLit "stg_ap_ppv", 3)
+slowCallPattern (PtrArg: PtrArg: _)                     = (fsLit "stg_ap_pp", 2)
+slowCallPattern (PtrArg: VoidArg: _)                    = (fsLit "stg_ap_pv", 2)
+slowCallPattern (PtrArg: _)                             = (fsLit "stg_ap_p", 1)
+slowCallPattern (VoidArg: _)                            = (fsLit "stg_ap_v", 1)
+slowCallPattern (NonPtrArg: _)                          = (fsLit "stg_ap_n", 1)
+slowCallPattern (FloatArg: _)                           = (fsLit "stg_ap_f", 1)
+slowCallPattern (DoubleArg: _)                          = (fsLit "stg_ap_d", 1)
+slowCallPattern (LongArg: _)                            = (fsLit "stg_ap_l", 1)
+slowCallPattern _                                       = panic "CgStackery.slowCallPattern"
 
 -------------------------------------------------------------------------
 --
---		Return conventions
+--              Return conventions
 --
 -------------------------------------------------------------------------
 
@@ -219,7 +212,7 @@ dataReturnConvPrim VoidArg   = panic "dataReturnConvPrim: void"
 
 -- getSequelAmode returns an amode which refers to an info table.  The info
 -- table will always be of the RET_(BIG|SMALL) kind.  We're careful
--- not to handle real code pointers, just in case we're compiling for 
+-- not to handle real code pointers, just in case we're compiling for
 -- an unregisterised/untailcallish architecture, where info pointers and
 -- code pointers aren't the same.
 -- DIRE WARNING.
@@ -230,60 +223,60 @@ dataReturnConvPrim VoidArg   = panic "dataReturnConvPrim: void"
 
 getSequelAmode :: FCode CmmExpr
 getSequelAmode
-  = do	{ EndOfBlockInfo virt_sp sequel <- getEndOfBlockInfo
-	; case sequel of
-	    OnStack -> do { sp_rel <- getSpRelOffset virt_sp
-			  ; returnFC (CmmLoad sp_rel bWord) }
+  = do  { EndOfBlockInfo virt_sp sequel <- getEndOfBlockInfo
+        ; case sequel of
+            OnStack -> do { sp_rel <- getSpRelOffset virt_sp
+                          ; returnFC (CmmLoad sp_rel bWord) }
 
-	    CaseAlts lbl _ _  -> returnFC (CmmLit (CmmLabel lbl))
-	}
+            CaseAlts lbl _ _  -> returnFC (CmmLit (CmmLabel lbl))
+        }
 
 -------------------------------------------------------------------------
 --
---		Register assignment
+--              Register assignment
 --
 -------------------------------------------------------------------------
 
---  How to assign registers for 
+--  How to assign registers for
 --
---	1) Calling a fast entry point.
---	2) Returning an unboxed tuple.
---	3) Invoking an out-of-line PrimOp.
+--      1) Calling a fast entry point.
+--      2) Returning an unboxed tuple.
+--      3) Invoking an out-of-line PrimOp.
 --
 -- Registers are assigned in order.
--- 
+--
 -- If we run out, we don't attempt to assign any further registers (even
 -- though we might have run out of only one kind of register); we just
 -- return immediately with the left-overs specified.
--- 
+--
 -- The alternative version @assignAllRegs@ uses the complete set of
 -- registers, including those that aren't mapped to real machine
 -- registers.  This is used for calling special RTS functions and PrimOps
 -- which expect their arguments to always be in the same registers.
 
 assignCallRegs, assignPrimOpCallRegs, assignReturnRegs
-	:: [(CgRep,a)]		-- Arg or result values to assign
-	-> ([(a, GlobalReg)],	-- Register assignment in same order
-				-- for *initial segment of* input list
-				--   (but reversed; doesn't matter)
-				-- VoidRep args do not appear here
-	    [(CgRep,a)])	-- Leftover arg or result values
+        :: [(CgRep,a)]          -- Arg or result values to assign
+        -> ([(a, GlobalReg)],   -- Register assignment in same order
+                                -- for *initial segment of* input list
+                                --   (but reversed; doesn't matter)
+                                -- VoidRep args do not appear here
+            [(CgRep,a)])        -- Leftover arg or result values
 
 assignCallRegs args
   = assign_regs args (mkRegTbl [node])
-	-- The entry convention for a function closure
-	-- never uses Node for argument passing; instead
-	-- Node points to the function closure itself
+        -- The entry convention for a function closure
+        -- never uses Node for argument passing; instead
+        -- Node points to the function closure itself
 
 assignPrimOpCallRegs args
  = assign_regs args (mkRegTbl_allRegs [])
-	-- For primops, *all* arguments must be passed in registers
+        -- For primops, *all* arguments must be passed in registers
 
 assignReturnRegs args
  -- when we have a single non-void component to return, use the normal
  -- unpointed return convention.  This make various things simpler: it
  -- means we can assume a consistent convention for IO, which is useful
- -- when writing code that relies on knowing the IO return convention in 
+ -- when writing code that relies on knowing the IO return convention in
  -- the RTS (primops, especially exception-related primops).
  -- Also, the bytecode compiler assumes this when compiling
  -- case expressions and ccalls, so it only needs to know one set of
@@ -292,24 +285,24 @@ assignReturnRegs args
     = ([(arg, r)], [])
  | otherwise
     = assign_regs args (mkRegTbl [])
-	-- For returning unboxed tuples etc, 
-	-- we use all regs
- where 
+        -- For returning unboxed tuples etc,
+        -- we use all regs
+ where
        non_void_args = filter ((/= VoidArg).fst) args
 
-assign_regs :: [(CgRep,a)]     	-- Arg or result values to assign
-	    -> AvailRegs	-- Regs still avail: Vanilla, Float, Double, Longs
-	    -> ([(a, GlobalReg)], [(CgRep, a)])
+assign_regs :: [(CgRep,a)]      -- Arg or result values to assign
+            -> AvailRegs        -- Regs still avail: Vanilla, Float, Double, Longs
+            -> ([(a, GlobalReg)], [(CgRep, a)])
 assign_regs args supply
   = go args [] supply
   where
-    go [] acc _ = (acc, [])	-- Return the results reversed (doesn't matter)
-    go ((VoidArg,_) : args) acc supply 	-- Skip void arguments; they aren't passed, and
-	= go args acc supply		-- there's nothing to bind them to
-    go ((rep,arg) : args) acc supply 
-	= case assign_reg rep supply of
-		Just (reg, supply') -> go args ((arg,reg):acc) supply'
-		Nothing	   	    -> (acc, (rep,arg):args) 	-- No more regs
+    go [] acc _ = (acc, [])     -- Return the results reversed (doesn't matter)
+    go ((VoidArg,_) : args) acc supply  -- Skip void arguments; they aren't passed, and
+        = go args acc supply            -- there's nothing to bind them to
+    go ((rep,arg) : args) acc supply
+        = case assign_reg rep supply of
+                Just (reg, supply') -> go args ((arg,reg):acc) supply'
+                Nothing             -> (acc, (rep,arg):args)    -- No more regs
 
 assign_reg :: CgRep -> AvailRegs -> Maybe (GlobalReg, AvailRegs)
 assign_reg FloatArg  (vs, f:fs, ds, ls) = Just (FloatReg f,   (vs, fs, ds, ls))
@@ -323,7 +316,7 @@ assign_reg _         _                  = Nothing
 
 -------------------------------------------------------------------------
 --
---		Register supplies
+--              Register supplies
 --
 -------------------------------------------------------------------------
 
@@ -335,37 +328,37 @@ assign_reg _         _                  = Nothing
 
 useVanillaRegs :: Int
 useVanillaRegs | opt_Unregisterised = 0
-	       | otherwise          = mAX_Real_Vanilla_REG
+               | otherwise          = mAX_Real_Vanilla_REG
 useFloatRegs :: Int
 useFloatRegs   | opt_Unregisterised = 0
-	       | otherwise          = mAX_Real_Float_REG
+               | otherwise          = mAX_Real_Float_REG
 useDoubleRegs :: Int
 useDoubleRegs  | opt_Unregisterised = 0
-	       | otherwise          = mAX_Real_Double_REG
+               | otherwise          = mAX_Real_Double_REG
 useLongRegs :: Int
 useLongRegs    | opt_Unregisterised = 0
-	       | otherwise          = mAX_Real_Long_REG
+               | otherwise          = mAX_Real_Long_REG
 
 vanillaRegNos, floatRegNos, doubleRegNos, longRegNos :: [Int]
-vanillaRegNos	 = regList useVanillaRegs
-floatRegNos	 = regList useFloatRegs
-doubleRegNos	 = regList useDoubleRegs
+vanillaRegNos    = regList useVanillaRegs
+floatRegNos      = regList useFloatRegs
+doubleRegNos     = regList useDoubleRegs
 longRegNos       = regList useLongRegs
 
 allVanillaRegNos, allFloatRegNos, allDoubleRegNos, allLongRegNos :: [Int]
 allVanillaRegNos = regList mAX_Vanilla_REG
-allFloatRegNos	 = regList mAX_Float_REG
-allDoubleRegNos	 = regList mAX_Double_REG
-allLongRegNos	 = regList mAX_Long_REG
+allFloatRegNos   = regList mAX_Float_REG
+allDoubleRegNos  = regList mAX_Double_REG
+allLongRegNos    = regList mAX_Long_REG
 
 regList :: Int -> [Int]
 regList n = [1 .. n]
 
 type AvailRegs = ( [Int]   -- available vanilla regs.
-		 , [Int]   -- floats
-		 , [Int]   -- doubles
-		 , [Int]   -- longs (int64 and word64)
-		 )
+                 , [Int]   -- floats
+                 , [Int]   -- doubles
+                 , [Int]   -- longs (int64 and word64)
+                 )
 
 mkRegTbl :: [GlobalReg] -> AvailRegs
 mkRegTbl regs_in_use
@@ -381,23 +374,23 @@ mkRegTbl' regs_in_use vanillas floats doubles longs
   = (ok_vanilla, ok_float, ok_double, ok_long)
   where
     ok_vanilla = mapCatMaybes (select (\i -> VanillaReg i VNonGcPtr)) vanillas
-		    -- ptrhood isn't looked at, hence we can use any old rep.
-    ok_float   = mapCatMaybes (select FloatReg)	  floats
+                    -- ptrhood isn't looked at, hence we can use any old rep.
+    ok_float   = mapCatMaybes (select FloatReg)   floats
     ok_double  = mapCatMaybes (select DoubleReg)  doubles
-    ok_long    = mapCatMaybes (select LongReg)    longs   
+    ok_long    = mapCatMaybes (select LongReg)    longs
 
     select :: (Int -> GlobalReg) -> Int{-cand-} -> Maybe Int
-	-- one we've unboxed the Int, we make a GlobalReg
-	-- and see if it is already in use; if not, return its number.
+        -- one we've unboxed the Int, we make a GlobalReg
+        -- and see if it is already in use; if not, return its number.
 
     select mk_reg_fun cand
       = let
-	    reg = mk_reg_fun cand
-	in
-	if reg `not_elem` regs_in_use
-	then Just cand
-	else Nothing
+            reg = mk_reg_fun cand
+        in
+        if reg `not_elem` regs_in_use
+        then Just cand
+        else Nothing
       where
-	not_elem = isn'tIn "mkRegTbl"
+        not_elem = isn'tIn "mkRegTbl"
 
 
diff --git a/compiler/codeGen/CgCase.lhs b/compiler/codeGen/CgCase.lhs
index a36621bdaf..dd607de1fc 100644
--- a/compiler/codeGen/CgCase.lhs
+++ b/compiler/codeGen/CgCase.lhs
@@ -4,20 +4,16 @@
 %
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
 
-module CgCase (	cgCase, saveVolatileVarsAndRegs, 
-		restoreCurrentCostCentre
-	) where
+module CgCase (
+        cgCase,
+        saveVolatileVarsAndRegs,
+        restoreCurrentCostCentre
+    ) where
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} CgExpr  ( cgExpr )
+import {-# SOURCE #-} CgExpr ( cgExpr )
 
 import CgMonad
 import CgBindery
@@ -54,12 +50,12 @@ import Control.Monad (when)
 
 \begin{code}
 data GCFlag
-  = GCMayHappen	-- The scrutinee may involve GC, so everything must be
-		-- tidy before the code for the scrutinee.
+  = GCMayHappen -- The scrutinee may involve GC, so everything must be
+                -- tidy before the code for the scrutinee.
 
-  | NoGC	-- The scrutinee is a primitive value, or a call to a
-		-- primitive op which does no GC.  Hence the case can
-		-- be done inline, without tidying up first.
+  | NoGC        -- The scrutinee is a primitive value, or a call to a
+                -- primitive op which does no GC.  Hence the case can
+                -- be done inline, without tidying up first.
 \end{code}
 
 It is quite interesting to decide whether to put a heap-check
@@ -70,11 +66,11 @@ op which can trigger GC.
 A more interesting situation is this:
 
  \begin{verbatim}
-	!A!;
-	...A...
-	case x# of
-	  0#      -> !B!; ...B...
-	  default -> !C!; ...C...
+        !A!;
+        ...A...
+        case x# of
+          0#      -> !B!; ...B...
+          default -> !C!; ...C...
  \end{verbatim}
 
 where \tr{!x!} indicates a possible heap-check point. The heap checks
@@ -84,29 +80,29 @@ heapcheck will take their worst case into account.
 In favour of omitting \tr{!B!}, \tr{!C!}:
 
  - {\em May} save a heap overflow test,
-	if ...A... allocates anything.  The other advantage
-	of this is that we can use relative addressing
-	from a single Hp to get at all the closures so allocated.
+        if ...A... allocates anything.  The other advantage
+        of this is that we can use relative addressing
+        from a single Hp to get at all the closures so allocated.
 
  - No need to save volatile vars etc across the case
 
 Against:
 
   - May do more allocation than reqd.  This sometimes bites us
-	badly.  For example, nfib (ha!)  allocates about 30\% more space if the
-	worst-casing is done, because many many calls to nfib are leaf calls
-	which don't need to allocate anything.
+        badly.  For example, nfib (ha!)  allocates about 30\% more space if the
+        worst-casing is done, because many many calls to nfib are leaf calls
+        which don't need to allocate anything.
 
-	This never hurts us if there is only one alternative.
+        This never hurts us if there is only one alternative.
 
 \begin{code}
-cgCase	:: StgExpr
-	-> StgLiveVars
-	-> StgLiveVars
-	-> Id
-	-> AltType
-	-> [StgAlt]
-	-> Code
+cgCase  :: StgExpr
+        -> StgLiveVars
+        -> StgLiveVars
+        -> Id
+        -> AltType
+        -> [StgAlt]
+        -> Code
 \end{code}
 
 Special case #1: case of literal.
@@ -114,15 +110,15 @@ Special case #1: case of literal.
 \begin{code}
 cgCase (StgLit lit) _live_in_whole_case _live_in_alts bndr
        alt_type@(PrimAlt _) alts
-  = do	{ tmp_reg <- bindNewToTemp bndr
-	; cm_lit <- cgLit lit
-	; stmtC (CmmAssign (CmmLocal tmp_reg) (CmmLit cm_lit))
-	; cgPrimAlts NoGC alt_type (CmmLocal tmp_reg) alts }
+  = do  { tmp_reg <- bindNewToTemp bndr
+        ; cm_lit <- cgLit lit
+        ; stmtC (CmmAssign (CmmLocal tmp_reg) (CmmLit cm_lit))
+        ; cgPrimAlts NoGC alt_type (CmmLocal tmp_reg) alts }
 \end{code}
 
-Special case #2: scrutinising a primitive-typed variable.	No
+Special case #2: scrutinising a primitive-typed variable.       No
 evaluation required.  We don't save volatile variables, nor do we do a
-heap-check in the alternatives.	 Instead, the heap usage of the
+heap-check in the alternatives.  Instead, the heap usage of the
 alternatives is worst-cased and passed upstream.  This can result in
 allocating more heap than strictly necessary, but it will sometimes
 eliminate a heap check altogether.
@@ -159,15 +155,15 @@ cgCase (StgApp v []) _live_in_whole_case _live_in_alts bndr
             panic "cgCase: reps do not match, perhaps a dodgy unsafeCoerce?"
 
           -- Careful! we can't just bind the default binder to the same thing
-	  -- as the scrutinee, since it might be a stack location, and having
-	  -- two bindings pointing at the same stack locn doesn't work (it
-	  -- confuses nukeDeadBindings).  Hence, use a new temp.
-	; v_info <- getCgIdInfo v
-	; amode <- idInfoToAmode v_info
-	; tmp_reg <- bindNewToTemp bndr
-	; stmtC (CmmAssign (CmmLocal tmp_reg) amode)
-
-	; cgPrimAlts NoGC alt_type (CmmLocal tmp_reg) alts }
+          -- as the scrutinee, since it might be a stack location, and having
+          -- two bindings pointing at the same stack locn doesn't work (it
+          -- confuses nukeDeadBindings).  Hence, use a new temp.
+        ; v_info <- getCgIdInfo v
+        ; amode <- idInfoToAmode v_info
+        ; tmp_reg <- bindNewToTemp bndr
+        ; stmtC (CmmAssign (CmmLocal tmp_reg) amode)
+
+        ; cgPrimAlts NoGC alt_type (CmmLocal tmp_reg) alts }
   where
     reps_compatible = idCgRep v == idCgRep bndr
 \end{code}
@@ -194,7 +190,7 @@ cgCase (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _)
 Special case #3: inline PrimOps and foreign calls.
 
 \begin{code}
-cgCase (StgOpApp (StgPrimOp primop) args _) 
+cgCase (StgOpApp (StgPrimOp primop) args _)
        _live_in_whole_case live_in_alts bndr alt_type alts
   | not (primOpOutOfLine primop)
   = cgInlinePrimOp primop args bndr alt_type live_in_alts alts
@@ -209,23 +205,23 @@ Special case #4: inline foreign calls: an unsafe foreign call can be done
 right here, just like an inline primop.
 
 \begin{code}
-cgCase (StgOpApp (StgFCallOp fcall _) args _) 
+cgCase (StgOpApp (StgFCallOp fcall _) args _)
        _live_in_whole_case live_in_alts _bndr _alt_type alts
   | unsafe_foreign_call
   = ASSERT( isSingleton alts )
-    do	--  *must* be an unboxed tuple alt.
-	-- exactly like the cgInlinePrimOp case for unboxed tuple alts..
-	{ res_tmps <- mapFCs bindNewToTemp non_void_res_ids
-	; let res_hints = map (typeForeignHint.idType) non_void_res_ids
-	; cgForeignCall (zipWith CmmHinted res_tmps res_hints) fcall args live_in_alts
-	; cgExpr rhs }
+    do  --  *must* be an unboxed tuple alt.
+        -- exactly like the cgInlinePrimOp case for unboxed tuple alts..
+        { res_tmps <- mapFCs bindNewToTemp non_void_res_ids
+        ; let res_hints = map (typeForeignHint.idType) non_void_res_ids
+        ; cgForeignCall (zipWith CmmHinted res_tmps res_hints) fcall args live_in_alts
+        ; cgExpr rhs }
   where
    (_, res_ids, _, rhs) = head alts
    non_void_res_ids = filter (nonVoidArg . idCgRep) res_ids
 
    unsafe_foreign_call
-	 = case fcall of
-	 	CCall (CCallSpec _ _ s) -> not (playSafe s)
+         = case fcall of
+                CCall (CCallSpec _ _ s) -> not (playSafe s)
 \end{code}
 
 Special case: scrutinising a non-primitive variable.
@@ -234,28 +230,28 @@ we can reuse/trim the stack slot holding the variable (if it is in one).
 
 \begin{code}
 cgCase (StgApp fun args)
-	_live_in_whole_case live_in_alts bndr alt_type alts
-  = do	{ fun_info <- getCgIdInfo fun
-	; arg_amodes <- getArgAmodes args
-
-	-- Nuking dead bindings *before* calculating the saves is the
-	-- value-add here.  We might end up freeing up some slots currently
-	-- occupied by variables only required for the call.
-	-- NOTE: we need to look up the variables used in the call before
-	-- doing this, because some of them may not be in the environment
-	-- afterward.
-	; nukeDeadBindings live_in_alts	
-	; (save_assts, alts_eob_info, maybe_cc_slot)
-		<- saveVolatileVarsAndRegs live_in_alts
-
-	; scrut_eob_info
-	    <- forkEval alts_eob_info 
-			(allocStackTop retAddrSizeW >> nopC)
-			(do { deAllocStackTop retAddrSizeW
-			    ; cgEvalAlts maybe_cc_slot bndr alt_type alts })
-
-	; setEndOfBlockInfo scrut_eob_info
-			    (performTailCall fun_info arg_amodes save_assts) }
+        _live_in_whole_case live_in_alts bndr alt_type alts
+  = do  { fun_info <- getCgIdInfo fun
+        ; arg_amodes <- getArgAmodes args
+
+        -- Nuking dead bindings *before* calculating the saves is the
+        -- value-add here.  We might end up freeing up some slots currently
+        -- occupied by variables only required for the call.
+        -- NOTE: we need to look up the variables used in the call before
+        -- doing this, because some of them may not be in the environment
+        -- afterward.
+        ; nukeDeadBindings live_in_alts
+        ; (save_assts, alts_eob_info, maybe_cc_slot)
+            <- saveVolatileVarsAndRegs live_in_alts
+
+        ; scrut_eob_info
+            <- forkEval alts_eob_info
+                        (allocStackTop retAddrSizeW >> nopC)
+                        (do { deAllocStackTop retAddrSizeW
+                            ; cgEvalAlts maybe_cc_slot bndr alt_type alts })
+
+        ; setEndOfBlockInfo scrut_eob_info
+                            (performTailCall fun_info arg_amodes save_assts) }
 \end{code}
 
 Note about return addresses: we *always* push a return address, even
@@ -273,25 +269,25 @@ Finally, here is the general case.
 
 \begin{code}
 cgCase expr live_in_whole_case live_in_alts bndr alt_type alts
-  = do	{	-- Figure out what volatile variables to save
-	  nukeDeadBindings live_in_whole_case
-    
-	; (save_assts, alts_eob_info, maybe_cc_slot)
-		<- saveVolatileVarsAndRegs live_in_alts
-
-	     -- Save those variables right now!
-	; emitStmts save_assts
-
-	    -- generate code for the alts
-	; scrut_eob_info
-	       <- forkEval alts_eob_info
-		      	   (do 	{ nukeDeadBindings live_in_alts
-				; allocStackTop retAddrSizeW   -- space for retn address 
-				; nopC })
-			   (do	{ deAllocStackTop retAddrSizeW
-				; cgEvalAlts maybe_cc_slot bndr alt_type alts })
-
-	; setEndOfBlockInfo scrut_eob_info (cgExpr expr)
+  = do  {       -- Figure out what volatile variables to save
+          nukeDeadBindings live_in_whole_case
+
+        ; (save_assts, alts_eob_info, maybe_cc_slot)
+                <- saveVolatileVarsAndRegs live_in_alts
+
+             -- Save those variables right now!
+        ; emitStmts save_assts
+
+            -- generate code for the alts
+        ; scrut_eob_info
+               <- forkEval alts_eob_info
+                           (do  { nukeDeadBindings live_in_alts
+                                ; allocStackTop retAddrSizeW   -- space for retn address
+                                ; nopC })
+                           (do  { deAllocStackTop retAddrSizeW
+                                ; cgEvalAlts maybe_cc_slot bndr alt_type alts })
+
+        ; setEndOfBlockInfo scrut_eob_info (cgExpr expr)
     }
 \end{code}
 
@@ -300,15 +296,15 @@ stack pointer here.  forkEval takes the virtual Sp and free list from
 the first argument, and turns that into the *real* Sp for the second
 argument.  It also uses this virtual Sp as the args-Sp in the EOB info
 returned, so that the scrutinee will trim the real Sp back to the
-right place before doing whatever it does.  
-  --SDM (who just spent an hour figuring this out, and didn't want to 
-	 forget it).
+right place before doing whatever it does.
+  --SDM (who just spent an hour figuring this out, and didn't want to
+         forget it).
 
 Why don't we push the return address just before evaluating the
 scrutinee?  Because the slot reserved for the return address might
 contain something useful, so we wait until performing a tail call or
 return before pushing the return address (see
-CgTailCall.pushReturnAddress).  
+CgTailCall.pushReturnAddress).
 
 This also means that the environment doesn't need to know about the
 free stack slot for the return address (for generating bitmaps),
@@ -322,9 +318,9 @@ follow the layout of closures when we're profiling.  The CCS could be
 anywhere within the record).
 
 %************************************************************************
-%*									*
-		Inline primops
-%*									*
+%*                                                                      *
+                Inline primops
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -334,78 +330,78 @@ cgInlinePrimOp :: PrimOp -> [StgArg] -> Id -> AltType -> StgLiveVars
 cgInlinePrimOp primop args bndr (PrimAlt _) live_in_alts alts
   | isVoidArg (idCgRep bndr)
   = ASSERT( con == DEFAULT && isSingleton alts && null bs )
-    do	{ 	-- VOID RESULT; just sequencing, 
-		-- so get in there and do it
-		-- The bndr should not occur, so no need to bind it
-	  cgPrimOp [] primop args live_in_alts
-	; cgExpr rhs }
+    do  {       -- VOID RESULT; just sequencing,
+                -- so get in there and do it
+                -- The bndr should not occur, so no need to bind it
+          cgPrimOp [] primop args live_in_alts
+        ; cgExpr rhs }
   where
     (con,bs,_,rhs) = head alts
 
 cgInlinePrimOp primop args bndr (PrimAlt tycon) live_in_alts alts
-  = do	{ 	-- PRIMITIVE ALTS, with non-void result
-	  tmp_reg <- bindNewToTemp bndr
-	; cgPrimOp [tmp_reg] primop args live_in_alts
-	; cgPrimAlts NoGC (PrimAlt tycon) (CmmLocal tmp_reg) alts }
+  = do  {       -- PRIMITIVE ALTS, with non-void result
+          tmp_reg <- bindNewToTemp bndr
+        ; cgPrimOp [tmp_reg] primop args live_in_alts
+        ; cgPrimAlts NoGC (PrimAlt tycon) (CmmLocal tmp_reg) alts }
 
 cgInlinePrimOp primop args _ (UbxTupAlt _) live_in_alts alts
   = ASSERT( isSingleton alts )
-    do	{  	-- UNBOXED TUPLE ALTS
-	 	-- No heap check, no yield, just get in there and do it.
-		-- NB: the case binder isn't bound to anything; 
-		--     it has a unboxed tuple type
-	  
-	  res_tmps <- mapFCs bindNewToTemp non_void_res_ids
-	; cgPrimOp res_tmps primop args live_in_alts
-	; cgExpr rhs }
+    do  {       -- UNBOXED TUPLE ALTS
+                -- No heap check, no yield, just get in there and do it.
+                -- NB: the case binder isn't bound to anything;
+                --     it has a unboxed tuple type
+
+          res_tmps <- mapFCs bindNewToTemp non_void_res_ids
+        ; cgPrimOp res_tmps primop args live_in_alts
+        ; cgExpr rhs }
   where
    (_, res_ids, _, rhs) = head alts
    non_void_res_ids = filter (nonVoidArg . idCgRep) res_ids
 
 cgInlinePrimOp primop args bndr (AlgAlt tycon) live_in_alts alts
-  = do 	{ 	-- ENUMERATION TYPE RETURN
-		-- Typical: case a ># b of { True -> ..; False -> .. }
-		-- The primop itself returns an index into the table of
-		-- closures for the enumeration type.
-	   tag_amode <- ASSERT( isEnumerationTyCon tycon )
-			do_enum_primop primop
-
-	 	-- Bind the default binder if necessary
-		-- (avoiding it avoids the assignment)
-		-- The deadness info is set by StgVarInfo
-	; whenC (not (isDeadBinder bndr))
-		(do { tmp_reg <- bindNewToTemp bndr
-		    ; stmtC (CmmAssign
+  = do  {       -- ENUMERATION TYPE RETURN
+                -- Typical: case a ># b of { True -> ..; False -> .. }
+                -- The primop itself returns an index into the table of
+                -- closures for the enumeration type.
+           tag_amode <- ASSERT( isEnumerationTyCon tycon )
+                        do_enum_primop primop
+
+                -- Bind the default binder if necessary
+                -- (avoiding it avoids the assignment)
+                -- The deadness info is set by StgVarInfo
+        ; whenC (not (isDeadBinder bndr))
+                (do { tmp_reg <- bindNewToTemp bndr
+                    ; stmtC (CmmAssign
                              (CmmLocal tmp_reg)
                              (tagToClosure tycon tag_amode)) })
 
-		-- Compile the alts
-	; (branches, mb_deflt) <- cgAlgAlts NoGC Nothing{-cc_slot-}
-				   	    (AlgAlt tycon) alts
+                -- Compile the alts
+        ; (branches, mb_deflt) <- cgAlgAlts NoGC Nothing{-cc_slot-}
+                                            (AlgAlt tycon) alts
 
-		-- Do the switch
-	; emitSwitch tag_amode branches mb_deflt 0 (tyConFamilySize tycon - 1)
-	}
+                -- Do the switch
+        ; emitSwitch tag_amode branches mb_deflt 0 (tyConFamilySize tycon - 1)
+        }
   where
 
-    do_enum_primop :: PrimOp -> FCode CmmExpr	-- Returns amode for result
-    do_enum_primop TagToEnumOp	-- No code!
+    do_enum_primop :: PrimOp -> FCode CmmExpr   -- Returns amode for result
+    do_enum_primop TagToEnumOp  -- No code!
        | [arg] <- args = do
          (_,e) <- getArgAmode arg
-	 return e
+         return e
     do_enum_primop primop
       = do tmp <- newTemp bWord
-	   cgPrimOp [tmp] primop args live_in_alts
-    	   returnFC (CmmReg (CmmLocal tmp))
+           cgPrimOp [tmp] primop args live_in_alts
+           returnFC (CmmReg (CmmLocal tmp))
 
 cgInlinePrimOp _ _ bndr _ _ _
   = pprPanic "cgCase: case of primop has polymorphic type" (ppr bndr)
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[CgCase-alts]{Alternatives}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 @cgEvalAlts@ returns an addressing mode for a continuation for the
@@ -413,77 +409,77 @@ alternatives of a @case@, used in a context when there
 is some evaluation to be done.
 
 \begin{code}
-cgEvalAlts :: Maybe VirtualSpOffset	-- Offset of cost-centre to be restored, if any
-	   -> Id
-	   -> AltType
-	   -> [StgAlt]
-	   -> FCode Sequel	-- Any addr modes inside are guaranteed
-				-- to be a label so that we can duplicate it 
-				-- without risk of duplicating code
+cgEvalAlts :: Maybe VirtualSpOffset     -- Offset of cost-centre to be restored, if any
+           -> Id
+           -> AltType
+           -> [StgAlt]
+           -> FCode Sequel      -- Any addr modes inside are guaranteed
+                                -- to be a label so that we can duplicate it
+                                -- without risk of duplicating code
 
 cgEvalAlts cc_slot bndr alt_type@(PrimAlt tycon) alts
-  = do	{ let   rep = tyConCgRep tycon
-		reg = dataReturnConvPrim rep	-- Bottom for voidRep
+  = do  { let   rep = tyConCgRep tycon
+                reg = dataReturnConvPrim rep    -- Bottom for voidRep
 
-	; abs_c <- forkProc $ do
-		{ 	-- Bind the case binder, except if it's void
-			-- (reg is bottom in that case)
-		  whenC (nonVoidArg rep) $
-		  bindNewToReg bndr reg (mkLFArgument bndr)
-		; restoreCurrentCostCentre cc_slot True
-		; cgPrimAlts GCMayHappen alt_type reg alts }
+        ; abs_c <- forkProc $ do
+                {       -- Bind the case binder, except if it's void
+                        -- (reg is bottom in that case)
+                  whenC (nonVoidArg rep) $
+                  bindNewToReg bndr reg (mkLFArgument bndr)
+                ; restoreCurrentCostCentre cc_slot True
+                ; cgPrimAlts GCMayHappen alt_type reg alts }
 
-	; lbl <- emitReturnTarget (idName bndr) abs_c
-	; returnFC (CaseAlts lbl Nothing bndr) }
+        ; lbl <- emitReturnTarget (idName bndr) abs_c
+        ; returnFC (CaseAlts lbl Nothing bndr) }
 
 cgEvalAlts cc_slot bndr (UbxTupAlt _) [(con,args,_,rhs)]
-  =	-- Unboxed tuple case
-	-- By now, the simplifier should have have turned it
-	-- into 	case e of (# a,b #) -> e
-	-- There shouldn't be a 
-	--		case e of DEFAULT -> e
+  =     -- Unboxed tuple case
+        -- By now, the simplifier should have have turned it
+        -- into         case e of (# a,b #) -> e
+        -- There shouldn't be a
+        --              case e of DEFAULT -> e
     ASSERT2( case con of { DataAlt _ -> True; _ -> False },
-	     text "cgEvalAlts: dodgy case of unboxed tuple type" )
-    do	{ 	-- forkAbsC for the RHS, so that the envt is
-		-- not changed for the emitReturn call
-	  abs_c <- forkProc $ do 
-		{ (live_regs, ptrs, nptrs, _) <- bindUnboxedTupleComponents args
-			-- Restore the CC *after* binding the tuple components, 
-			-- so that we get the stack offset of the saved CC right.
-		; restoreCurrentCostCentre cc_slot True
-			-- Generate a heap check if necessary
-			-- and finally the code for the alternative
-		; unbxTupleHeapCheck live_regs ptrs nptrs noStmts
-				     (cgExpr rhs) }
-	; lbl <- emitReturnTarget (idName bndr) abs_c
-	; returnFC (CaseAlts lbl Nothing bndr) }
+             text "cgEvalAlts: dodgy case of unboxed tuple type" )
+    do  {       -- forkAbsC for the RHS, so that the envt is
+                -- not changed for the emitReturn call
+          abs_c <- forkProc $ do
+                { (live_regs, ptrs, nptrs, _) <- bindUnboxedTupleComponents args
+                        -- Restore the CC *after* binding the tuple components,
+                        -- so that we get the stack offset of the saved CC right.
+                ; restoreCurrentCostCentre cc_slot True
+                        -- Generate a heap check if necessary
+                        -- and finally the code for the alternative
+                ; unbxTupleHeapCheck live_regs ptrs nptrs noStmts
+                                     (cgExpr rhs) }
+        ; lbl <- emitReturnTarget (idName bndr) abs_c
+        ; returnFC (CaseAlts lbl Nothing bndr) }
 
 cgEvalAlts cc_slot bndr alt_type alts
-  = 	-- Algebraic and polymorphic case
-    do	{	-- Bind the default binder
-	  bindNewToReg bndr nodeReg (mkLFArgument bndr)
+  =     -- Algebraic and polymorphic case
+    do  {       -- Bind the default binder
+          bindNewToReg bndr nodeReg (mkLFArgument bndr)
 
-	-- Generate sequel info for use downstream
-	-- At the moment, we only do it if the type is vector-returnable.
-	-- Reason: if not, then it costs extra to label the
-	-- alternatives, because we'd get return code like:
-	--
-	--	switch TagReg { 0 : JMP(alt_1); 1 : JMP(alt_2) ..etc }
-	--
-	-- which is worse than having the alt code in the switch statement
+        -- Generate sequel info for use downstream
+        -- At the moment, we only do it if the type is vector-returnable.
+        -- Reason: if not, then it costs extra to label the
+        -- alternatives, because we'd get return code like:
+        --
+        --      switch TagReg { 0 : JMP(alt_1); 1 : JMP(alt_2) ..etc }
+        --
+        -- which is worse than having the alt code in the switch statement
 
-	; (alts, mb_deflt) <- cgAlgAlts GCMayHappen cc_slot alt_type alts
+        ; (alts, mb_deflt) <- cgAlgAlts GCMayHappen cc_slot alt_type alts
 
-	; (lbl, branches) <- emitAlgReturnTarget (idName bndr) 
-				alts mb_deflt fam_sz
+        ; (lbl, branches) <- emitAlgReturnTarget (idName bndr)
+                                alts mb_deflt fam_sz
 
-	; returnFC (CaseAlts lbl branches bndr) }
+        ; returnFC (CaseAlts lbl branches bndr) }
   where
     fam_sz = case alt_type of
-    		AlgAlt tc -> tyConFamilySize tc
-    		PolyAlt   -> 0
-    		PrimAlt _ -> panic "cgEvalAlts: PrimAlt"
-    		UbxTupAlt _ -> panic "cgEvalAlts: UbxTupAlt"
+                AlgAlt tc -> tyConFamilySize tc
+                PolyAlt   -> 0
+                PrimAlt _ -> panic "cgEvalAlts: PrimAlt"
+                UbxTupAlt _ -> panic "cgEvalAlts: UbxTupAlt"
 \end{code}
 
 
@@ -494,9 +490,9 @@ must be  propagated  to cgAlgAltRhs (where the  GRAN_YIELD  macro might  be
 emitted). Hence, the new Bool arg to cgAlgAltRhs.
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[CgCase-alg-alts]{Algebraic alternatives}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 In @cgAlgAlts@, none of the binders in the alternatives are
@@ -510,36 +506,36 @@ are inlined alternatives.
 \begin{code}
 cgAlgAlts :: GCFlag
        -> Maybe VirtualSpOffset
-       -> AltType				--  ** AlgAlt or PolyAlt only **
-       -> [StgAlt]				-- The alternatives
+       -> AltType                               --  ** AlgAlt or PolyAlt only **
+       -> [StgAlt]                              -- The alternatives
        -> FCode ( [(ConTagZ, CgStmts)], -- The branches
-		  Maybe CgStmts )	-- The default case
+                  Maybe CgStmts )       -- The default case
 
 cgAlgAlts gc_flag cc_slot alt_type alts
   = do alts <- forkAlts [ cgAlgAlt gc_flag cc_slot alt_type alt | alt <- alts]
        let
-	    mb_deflt = case alts of -- DEFAULT is always first, if present
-			 ((DEFAULT,blks) : _) -> Just blks
-			 _    		      -> Nothing
+            mb_deflt = case alts of -- DEFAULT is always first, if present
+                         ((DEFAULT,blks) : _) -> Just blks
+                         _                    -> Nothing
 
-	    branches = [(dataConTagZ con, blks) 
-	   	       | (DataAlt con, blks) <- alts]
+            branches = [(dataConTagZ con, blks)
+                       | (DataAlt con, blks) <- alts]
        -- in
        return (branches, mb_deflt)
 
 
 cgAlgAlt :: GCFlag
-      	 -> Maybe VirtualSpOffset	-- Turgid state
-      	 -> AltType			--  ** AlgAlt or PolyAlt only **
-      	 -> StgAlt
-      	 -> FCode (AltCon, CgStmts)
+         -> Maybe VirtualSpOffset       -- Turgid state
+         -> AltType                     --  ** AlgAlt or PolyAlt only **
+         -> StgAlt
+         -> FCode (AltCon, CgStmts)
 
 cgAlgAlt gc_flag cc_slot alt_type (con, args, _use_mask, rhs)
-  = do	{ abs_c <- getCgStmts $ do
-		{ bind_con_args con args
-		; restoreCurrentCostCentre cc_slot True
-		; maybeAltHeapCheck gc_flag alt_type (cgExpr rhs) }
-	; return (con, abs_c) }
+  = do  { abs_c <- getCgStmts $ do
+                { bind_con_args con args
+                ; restoreCurrentCostCentre cc_slot True
+                ; maybeAltHeapCheck gc_flag alt_type (cgExpr rhs) }
+        ; return (con, abs_c) }
   where
     bind_con_args DEFAULT      _    = nopC
     bind_con_args (DataAlt dc) args = bindConArgs dc args
@@ -548,9 +544,9 @@ cgAlgAlt gc_flag cc_slot alt_type (con, args, _use_mask, rhs)
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[CgCase-prim-alts]{Primitive alternatives}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 @cgPrimAlts@ generates suitable a @CSwitch@
@@ -562,10 +558,10 @@ As usual, no binders in the alternatives are yet bound.
 
 \begin{code}
 cgPrimAlts :: GCFlag
-	   -> AltType	-- Always PrimAlt, but passed to maybeAltHeapCheck
-	   -> CmmReg	-- Scrutinee
-	   -> [StgAlt]	-- Alternatives
-	   -> Code
+           -> AltType   -- Always PrimAlt, but passed to maybeAltHeapCheck
+           -> CmmReg    -- Scrutinee
+           -> [StgAlt]  -- Alternatives
+           -> Code
 -- NB: cgPrimAlts emits code that does the case analysis.
 -- It's often used in inline situations, rather than to genearte
 -- a labelled return point.  That's why its interface is a little
@@ -573,73 +569,73 @@ cgPrimAlts :: GCFlag
 --
 -- INVARIANT: the default binder is already bound
 cgPrimAlts gc_flag alt_type scrutinee alts
-  = do	{ tagged_absCs <- forkAlts (map (cgPrimAlt gc_flag alt_type) alts)
-	; let ((DEFAULT, deflt_absC) : others) = tagged_absCs	-- There is always a default
-	      alt_absCs = [(lit,rhs) | (LitAlt lit, rhs) <- others]
- 	; emitLitSwitch (CmmReg scrutinee) alt_absCs deflt_absC }
+  = do  { tagged_absCs <- forkAlts (map (cgPrimAlt gc_flag alt_type) alts)
+        ; let ((DEFAULT, deflt_absC) : others) = tagged_absCs   -- There is always a default
+              alt_absCs = [(lit,rhs) | (LitAlt lit, rhs) <- others]
+        ; emitLitSwitch (CmmReg scrutinee) alt_absCs deflt_absC }
 
 cgPrimAlt :: GCFlag
-	  -> AltType
-	  -> StgAlt				-- The alternative
-	  -> FCode (AltCon, CgStmts)	-- Its compiled form
+          -> AltType
+          -> StgAlt                             -- The alternative
+          -> FCode (AltCon, CgStmts)    -- Its compiled form
 
 cgPrimAlt gc_flag alt_type (con, [], [], rhs)
   = ASSERT( case con of { DEFAULT -> True; LitAlt _ -> True; _ -> False } )
-    do	{ abs_c <- getCgStmts (maybeAltHeapCheck gc_flag alt_type (cgExpr rhs)) 
-	; returnFC (con, abs_c) }
+    do  { abs_c <- getCgStmts (maybeAltHeapCheck gc_flag alt_type (cgExpr rhs))
+        ; returnFC (con, abs_c) }
 cgPrimAlt _ _ _ = panic "cgPrimAlt: non-empty lists"
 \end{code}
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[CgCase-tidy]{Code for tidying up prior to an eval}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
-maybeAltHeapCheck 
-	:: GCFlag 
-	-> AltType	-- PolyAlt, PrimAlt, AlgAlt, but *not* UbxTupAlt
-	-> Code		-- Continuation
-	-> Code
-maybeAltHeapCheck NoGC	      _        code = code
+maybeAltHeapCheck
+        :: GCFlag
+        -> AltType      -- PolyAlt, PrimAlt, AlgAlt, but *not* UbxTupAlt
+        -> Code         -- Continuation
+        -> Code
+maybeAltHeapCheck NoGC        _        code = code
 maybeAltHeapCheck GCMayHappen alt_type code = altHeapCheck alt_type code
 
 saveVolatileVarsAndRegs
     :: StgLiveVars                    -- Vars which should be made safe
-    -> FCode (CmmStmts,  	      -- Assignments to do the saves
-	      EndOfBlockInfo,	      -- sequel for the alts
+    -> FCode (CmmStmts,               -- Assignments to do the saves
+              EndOfBlockInfo,         -- sequel for the alts
               Maybe VirtualSpOffset)  -- Slot for current cost centre
 
 saveVolatileVarsAndRegs vars
-  = do	{ var_saves <- saveVolatileVars vars
-	; (maybe_cc_slot, cc_save) <- saveCurrentCostCentre
-	; eob_info <- getEndOfBlockInfo
-	; returnFC (var_saves `plusStmts` cc_save,
-		    eob_info,
-		    maybe_cc_slot) }
+  = do  { var_saves <- saveVolatileVars vars
+        ; (maybe_cc_slot, cc_save) <- saveCurrentCostCentre
+        ; eob_info <- getEndOfBlockInfo
+        ; returnFC (var_saves `plusStmts` cc_save,
+                    eob_info,
+                    maybe_cc_slot) }
 
 
-saveVolatileVars :: StgLiveVars		-- Vars which should be made safe
-		 -> FCode CmmStmts	-- Assignments to to the saves
+saveVolatileVars :: StgLiveVars         -- Vars which should be made safe
+                 -> FCode CmmStmts      -- Assignments to to the saves
 
 saveVolatileVars vars
-  = do	{ stmts_s <- mapFCs save_it (varSetElems vars)
-	; return (foldr plusStmts noStmts stmts_s) }
+  = do  { stmts_s <- mapFCs save_it (varSetElems vars)
+        ; return (foldr plusStmts noStmts stmts_s) }
   where
     save_it var
       = do { v <- getCAddrModeIfVolatile var
-	   ; case v of
-		Nothing	        -> return noStmts 	   -- Non-volatile
-		Just vol_amode  -> save_var var vol_amode  -- Aha! It's volatile
-	}
+           ; case v of
+                Nothing         -> return noStmts          -- Non-volatile
+                Just vol_amode  -> save_var var vol_amode  -- Aha! It's volatile
+        }
 
     save_var var vol_amode
       = do { slot <- allocPrimStack (idCgRep var)
-	   ; rebindToStack var slot
-	   ; sp_rel <- getSpRelOffset slot
-	   ; returnFC (oneStmt (CmmStore sp_rel vol_amode)) }
+           ; rebindToStack var slot
+           ; sp_rel <- getSpRelOffset slot
+           ; returnFC (oneStmt (CmmStore sp_rel vol_amode)) }
 \end{code}
 
 ---------------------------------------------------------------------------
@@ -651,25 +647,25 @@ virtual offset of the location, to pass on to the alternatives, and
 
 \begin{code}
 saveCurrentCostCentre ::
-	FCode (Maybe VirtualSpOffset,	-- Where we decide to store it
-	       CmmStmts)		-- Assignment to save it
+        FCode (Maybe VirtualSpOffset,   -- Where we decide to store it
+               CmmStmts)                -- Assignment to save it
 
 saveCurrentCostCentre
-  | not opt_SccProfilingOn 
+  | not opt_SccProfilingOn
   = returnFC (Nothing, noStmts)
   | otherwise
-  = do	{ slot <- allocPrimStack PtrArg
-	; sp_rel <- getSpRelOffset slot
-	; returnFC (Just slot,
-		    oneStmt (CmmStore sp_rel curCCS)) }
+  = do  { slot <- allocPrimStack PtrArg
+        ; sp_rel <- getSpRelOffset slot
+        ; returnFC (Just slot,
+                    oneStmt (CmmStore sp_rel curCCS)) }
 
 -- Sometimes we don't free the slot containing the cost centre after restoring it
 -- (see CgLetNoEscape.cgLetNoEscapeBody).
 restoreCurrentCostCentre :: Maybe VirtualSpOffset -> Bool -> Code
 restoreCurrentCostCentre Nothing     _freeit = nopC
 restoreCurrentCostCentre (Just slot) freeit
- = do 	{ sp_rel <- getSpRelOffset slot
-	; whenC freeit (freeStackSlots [slot])
+ = do   { sp_rel <- getSpRelOffset slot
+        ; whenC freeit (freeStackSlots [slot])
         ; stmtC (storeCurCCS (CmmLoad sp_rel bWord)) }
 \end{code}
 
diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs
index 7bad8516d9..d6537c27e5 100644
--- a/compiler/codeGen/CgClosure.lhs
+++ b/compiler/codeGen/CgClosure.lhs
@@ -362,6 +362,7 @@ mkSlowEntryCode cl_info reg_args
 	= mapAccumL (\off (rep,_) -> (off + cgRepSizeW rep, off))
 		    0 reps_w_regs
 
+
      load_assts = zipWithEqual "mk_load" mk_load reps_w_regs stk_offsets
      mk_load (rep,reg) offset = CmmAssign (CmmGlobal reg) 
 					  (CmmLoad (cmmRegOffW spReg offset)
@@ -374,7 +375,8 @@ mkSlowEntryCode cl_info reg_args
 
      stk_adj_pop   = CmmAssign spReg (cmmRegOffW spReg final_stk_offset)
      stk_adj_push  = CmmAssign spReg (cmmRegOffW spReg (- final_stk_offset))
-     jump_to_entry = CmmJump (mkLblExpr (enterLocalIdLabel name has_caf_refs)) []
+     live_regs     = Just $ map snd reps_w_regs
+     jump_to_entry = CmmJump (mkLblExpr (entryLabelFromCI cl_info)) live_regs
 \end{code}
 
 
@@ -412,6 +414,7 @@ funWrapper :: ClosureInfo 	-- Closure whose code body this is
 	   -> Code
 funWrapper closure_info arg_regs reg_save_code fun_body = do
   { let node_points = nodeMustPointToIt (closureLFInfo closure_info)
+        live        = Just $ map snd arg_regs
 
   {-
         -- Debugging: check that R1 has the correct tag
@@ -431,8 +434,7 @@ funWrapper closure_info arg_regs reg_save_code fun_body = do
   ; granYield arg_regs node_points
 
         -- Heap and/or stack checks wrap the function body
-  ; funEntryChecks closure_info reg_save_code 
-		   fun_body
+  ; funEntryChecks closure_info reg_save_code live fun_body
   }
 \end{code}
 
@@ -590,7 +592,7 @@ link_caf cl_info _is_upd = do
         -- assuming lots of things, like the stack pointer hasn't
         -- moved since we entered the CAF.
         let target = entryCode (closureInfoPtr (CmmReg nodeReg)) in
-        stmtC (CmmJump target [])
+        stmtC (CmmJump target $ Just [node])
 
   ; returnFC hp_rel }
   where
diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs
index 17bb9d0ad8..9049504dca 100644
--- a/compiler/codeGen/CgCon.lhs
+++ b/compiler/codeGen/CgCon.lhs
@@ -116,7 +116,7 @@ buildDynCon :: Id                 -- Name of the thing to which this constr will
             -> CostCentreStack    -- Where to grab cost centre from;
                                   -- current CCS if currentOrSubsumedCCS
             -> DataCon            -- The data constructor
-            -> [(CgRep,CmmExpr)] -- Its args
+            -> [(CgRep,CmmExpr)]  -- Its args
             -> FCode CgIdInfo     -- Return details about how to find it
 buildDynCon binder ccs con args
     = do dflags <- getDynFlags
@@ -348,12 +348,15 @@ cgReturnDataCon con amodes
                         | otherwise         -> build_it_then (jump_to deflt_lbl) }
 
             _otherwise  -- The usual case
-              -> build_it_then emitReturnInstr
+              -> build_it_then $ emitReturnInstr node_live
         }
   where
+    node_live   = Just [node]
     enter_it    = stmtsC [ CmmAssign nodeReg (cmmUntag (CmmReg nodeReg)),
-                           CmmJump (entryCode (closureInfoPtr (CmmReg nodeReg))) [] ]
-    jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
+                           CmmJump (entryCode $ closureInfoPtr $ CmmReg nodeReg)
+                                   node_live
+                         ]
+    jump_to lbl = stmtC $ CmmJump (CmmLit lbl) node_live
     build_it_then return_code
       = do {    -- BUILD THE OBJECT IN THE HEAP
                 -- The first "con" says that the name bound to this
@@ -472,7 +475,7 @@ cgDataCon data_con
                            -- The case continuation code is expecting a tagged pointer
                            ; stmtC (CmmAssign nodeReg
                                               (tagCons data_con (CmmReg nodeReg)))
-                           ; performReturn emitReturnInstr }
+                           ; performReturn $ emitReturnInstr (Just []) }
                                 -- noStmts: Ptr to thing already in Node
 
         ; whenC (not (isNullaryRepDataCon data_con))
diff --git a/compiler/codeGen/CgExpr.lhs b/compiler/codeGen/CgExpr.lhs
index e69db9f61b..cb3a86ef7f 100644
--- a/compiler/codeGen/CgExpr.lhs
+++ b/compiler/codeGen/CgExpr.lhs
@@ -149,7 +149,7 @@ cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
 	; amode' <- assignTemp amode	-- We're going to use it twice,
 					-- so save in a temp if non-trivial
 	; stmtC (CmmAssign nodeReg (tagToClosure tycon amode'))
-	; performReturn emitReturnInstr }
+	; performReturn $ emitReturnInstr (Just [node]) }
    where
 	  -- If you're reading this code in the attempt to figure
 	  -- out why the compiler panic'ed here, it is probably because
@@ -172,7 +172,8 @@ cgExpr (StgOpApp (StgPrimOp primop) args res_ty)
 
   | ReturnsPrim VoidRep <- result_info
 	= do cgPrimOp [] primop args emptyVarSet
-	     performReturn emitReturnInstr
+             -- ToDo: STG Live -- worried about this
+	     performReturn $ emitReturnInstr (Just [])
 
   | ReturnsPrim rep <- result_info
 	= do res <- newTemp (typeCmmType res_ty)
@@ -191,7 +192,8 @@ cgExpr (StgOpApp (StgPrimOp primop) args res_ty)
 	     stmtC (CmmAssign nodeReg
                     (tagToClosure tycon
                      (CmmReg (CmmLocal tag_reg))))
-	     performReturn emitReturnInstr
+             -- ToDo: STG Live -- worried about this
+	     performReturn $ emitReturnInstr (Just [node])
   where
 	result_info = getPrimOpResultInfo primop
 
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index 8d8b97d76a..09636bc6b2 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -7,15 +7,15 @@
 -----------------------------------------------------------------------------
 
 module CgForeignCall (
-  cgForeignCall,
-  emitForeignCall,
-  emitForeignCall',
-  shimForeignCallArg,
-  emitSaveThreadState, -- will be needed by the Cmm parser
-  emitLoadThreadState, -- ditto
-  emitCloseNursery,
-  emitOpenNursery,
- ) where
+        cgForeignCall,
+        emitForeignCall,
+        emitForeignCall',
+        shimForeignCallArg,
+        emitSaveThreadState, -- will be needed by the Cmm parser
+        emitLoadThreadState, -- ditto
+        emitCloseNursery,
+        emitOpenNursery,
+    ) where
 
 import StgSyn
 import CgProf
@@ -271,7 +271,7 @@ nursery_bdescr_blocks = cmmOffset stgCurrentNursery oFFSET_bdescr_blocks
 
 tso_stackobj, tso_CCCS, stack_STACK, stack_SP :: ByteOff
 tso_stackobj = closureField oFFSET_StgTSO_stackobj
-tso_CCCS     = closureField oFFSET_StgTSO_CCCS
+tso_CCCS     = closureField oFFSET_StgTSO_cccs
 stack_STACK  = closureField oFFSET_StgStack_stack
 stack_SP     = closureField oFFSET_StgStack_sp
 
diff --git a/compiler/codeGen/CgHeapery.lhs b/compiler/codeGen/CgHeapery.lhs
index 03b5deb058..dfe146dfc8 100644
--- a/compiler/codeGen/CgHeapery.lhs
+++ b/compiler/codeGen/CgHeapery.lhs
@@ -54,6 +54,7 @@ import Outputable
 import FastString
 
 import Data.List
+import Data.Maybe (fromMaybe)
 \end{code}
 
 
@@ -273,21 +274,22 @@ an automatic context switch is done.
 A heap/stack check at a function or thunk entry point.
 
 \begin{code}
-funEntryChecks :: ClosureInfo -> CmmStmts -> Code -> Code
-funEntryChecks cl_info reg_save_code code 
-  = hpStkCheck cl_info True reg_save_code code
+funEntryChecks :: ClosureInfo -> CmmStmts -> Maybe [GlobalReg] -> Code -> Code
+funEntryChecks cl_info reg_save_code live code 
+  = hpStkCheck cl_info True reg_save_code live code
 
 thunkEntryChecks :: ClosureInfo -> Code -> Code
 thunkEntryChecks cl_info code 
-  = hpStkCheck cl_info False noStmts code
+  = hpStkCheck cl_info False noStmts (Just [node]) code
 
 hpStkCheck :: ClosureInfo	-- Function closure
 	   -> Bool 		-- Is a function? (not a thunk)
 	   -> CmmStmts		-- Register saves
+           -> Maybe [GlobalReg] -- Live registers
 	   -> Code
 	   -> Code
 
-hpStkCheck cl_info is_fun reg_save_code code
+hpStkCheck cl_info is_fun reg_save_code live code
   =  getFinalStackHW	$ \ spHw -> do
 	{ sp <- getRealSp
 	; let stk_words = spHw - sp
@@ -295,17 +297,18 @@ hpStkCheck cl_info is_fun reg_save_code code
 	    {	-- Emit heap checks, but be sure to do it lazily so 
 		-- that the conditionals on hpHw don't cause a black hole
 	      codeOnly $ do
-		{ do_checks stk_words hpHw full_save_code rts_label
+		{ do_checks stk_words hpHw full_save_code rts_label full_live
 		; tickyAllocHeap hpHw }
 	    ; setRealHp hpHw
 	    ; code }
 	}
   where
-    node_asst 
+    (node_asst, full_live)
 	| nodeMustPointToIt (closureLFInfo cl_info)
-	= noStmts
+	= (noStmts, live)
 	| otherwise
-	= oneStmt (CmmAssign nodeReg (CmmLit (CmmLabel closure_lbl)))
+	= (oneStmt (CmmAssign nodeReg (CmmLit (CmmLabel closure_lbl)))
+          ,Just $ node : fromMaybe [] live)
         -- Strictly speaking, we should tag node here.  But if
         -- node doesn't point to the closure, the code for the closure
         -- cannot depend on the value of R1 anyway, so we're safe.
@@ -349,12 +352,17 @@ altHeapCheck alt_type code
 	{ codeOnly $ do
 	     { do_checks 0 {- no stack chk -} hpHw
 			 noStmts {- nothign to save -}
-			 (rts_label alt_type)
+			 rts_label live
 	     ; tickyAllocHeap hpHw }
 	; setRealHp hpHw
 	; code }
   where
-    rts_label PolyAlt = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_unpt_r1")))
+    (rts_label, live) = gc_info alt_type
+
+    mkL l = CmmLit . CmmLabel $ mkCmmCodeLabel rtsPackageId (fsLit l)
+
+    gc_info PolyAlt = (mkL "stg_gc_unpt_r1" , Just [node])
+
       	-- Do *not* enter R1 after a heap check in
 	-- a polymorphic case.  It might be a function
 	-- and the entry code for a function (currently)
@@ -362,22 +370,21 @@ altHeapCheck alt_type code
 	--
 	-- However R1 is guaranteed to be a pointer
 
-    rts_label (AlgAlt _) = stg_gc_enter1
+    gc_info (AlgAlt _) = (stg_gc_enter1, Just [node])
 	-- Enter R1 after the heap check; it's a pointer
  	
-    rts_label (PrimAlt tc)
-      = CmmLit $ CmmLabel $ 
-	case primRepToCgRep (tyConPrimRep tc) of
-	  VoidArg   -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_noregs")
-	  FloatArg  -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_f1")
-	  DoubleArg -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_d1")
-	  LongArg   -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_l1")
+    gc_info (PrimAlt tc)
+      = case primRepToCgRep (tyConPrimRep tc) of
+	  VoidArg   -> (mkL "stg_gc_noregs", Just [])
+	  FloatArg  -> (mkL "stg_gc_f1", Just [FloatReg 1])
+	  DoubleArg -> (mkL "stg_gc_d1", Just [DoubleReg 1])
+	  LongArg   -> (mkL "stg_gc_l1", Just [LongReg 1])
 				-- R1 is boxed but unlifted: 
-	  PtrArg    -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_unpt_r1")
+	  PtrArg    -> (mkL "stg_gc_unpt_r1", Just [node])
 				-- R1 is unboxed:
-	  NonPtrArg -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_unbx_r1")
+	  NonPtrArg -> (mkL "stg_gc_unbx_r1", Just [node])
 
-    rts_label (UbxTupAlt _) = panic "altHeapCheck"
+    gc_info (UbxTupAlt _) = panic "altHeapCheck"
 \end{code}
 
 
@@ -404,7 +411,7 @@ unbxTupleHeapCheck regs ptrs nptrs fail_code code
   | otherwise 
   = initHeapUsage $ \ hpHw -> do
 	{ codeOnly $ do { do_checks 0 {- no stack check -} hpHw
-				    full_fail_code rts_label
+				    full_fail_code rts_label live
 			; tickyAllocHeap hpHw }
 	; setRealHp hpHw
 	; code }
@@ -413,6 +420,7 @@ unbxTupleHeapCheck regs ptrs nptrs fail_code code
     assign_liveness = CmmAssign (CmmGlobal (VanillaReg 9 VNonGcPtr)) 	-- Ho ho ho!
 				(CmmLit (mkWordCLit liveness))
     liveness 	    = mkRegLiveness regs ptrs nptrs
+    live            = Just $ map snd regs
     rts_label	    = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_ut")))
 
 \end{code}
@@ -434,14 +442,15 @@ again on re-entry because someone else might have stolen the resource
 in the meantime.
 
 \begin{code}
-do_checks :: WordOff	-- Stack headroom
-	  -> WordOff	-- Heap  headroom
-	  -> CmmStmts	-- Assignments to perform on failure
-	  -> CmmExpr	-- Rts address to jump to on failure
+do_checks :: WordOff	       -- Stack headroom
+	  -> WordOff	       -- Heap  headroom
+	  -> CmmStmts	       -- Assignments to perform on failure
+	  -> CmmExpr	       -- Rts address to jump to on failure
+          -> Maybe [GlobalReg] -- Live registers
 	  -> Code
-do_checks 0 0 _ _   = nopC
+do_checks 0 0 _ _ _ = nopC
 
-do_checks _ hp _ _
+do_checks _ hp _ _ _
   | hp > bLOCKS_PER_MBLOCK * bLOCK_SIZE_W
   = sorry (unlines [
             "Trying to allocate more than " ++ show (bLOCKS_PER_MBLOCK * bLOCK_SIZE) ++ " bytes.", 
@@ -450,21 +459,22 @@ do_checks _ hp _ _
             "Suggestion: read data from a file instead of having large static data",
             "structures in the code."])
 
-do_checks stk hp reg_save_code rts_lbl
+do_checks stk hp reg_save_code rts_lbl live
   = do_checks' (CmmLit (mkIntCLit (stk*wORD_SIZE))) 
 	       (CmmLit (mkIntCLit (hp*wORD_SIZE)))
-	 (stk /= 0) (hp /= 0) reg_save_code rts_lbl
+	 (stk /= 0) (hp /= 0) reg_save_code rts_lbl live
 
 -- The offsets are now in *bytes*
-do_checks' :: CmmExpr -> CmmExpr -> Bool -> Bool -> CmmStmts -> CmmExpr -> Code
-do_checks' stk_expr hp_expr stk_nonzero hp_nonzero reg_save_code rts_lbl
+do_checks' :: CmmExpr -> CmmExpr -> Bool -> Bool -> CmmStmts -> CmmExpr 
+           -> Maybe [GlobalReg] -> Code
+do_checks' stk_expr hp_expr stk_nonzero hp_nonzero reg_save_code rts_lbl live
   = do	{ doGranAllocate hp_expr
 
         -- The failure block: this saves the registers and jumps to
         -- the appropriate RTS stub.
         ; exit_blk_id <- forkLabelledCode $ do {
 			; emitStmts reg_save_code
-			; stmtC (CmmJump rts_lbl []) }
+			; stmtC (CmmJump rts_lbl live) }
 
 	-- In the case of a heap-check failure, we must also set
 	-- HpAlloc.  NB. HpAlloc is *only* set if Hp has been
@@ -514,7 +524,8 @@ do_checks' stk_expr hp_expr stk_nonzero hp_nonzero reg_save_code rts_lbl
 \begin{code}
 hpChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> Code
 hpChkGen bytes liveness reentry
-  = do_checks' (CmmLit (mkIntCLit 0)) bytes False True assigns stg_gc_gen
+  = do_checks' (CmmLit (mkIntCLit 0)) bytes False True assigns
+          stg_gc_gen (Just activeStgRegs)
   where
     assigns = mkStmts [ mk_vanilla_assignment 9 liveness,
 	    		mk_vanilla_assignment 10 reentry ]
@@ -523,12 +534,14 @@ hpChkGen bytes liveness reentry
 -- we want to assign to Sp[0] on failure (used in AutoApply.cmm:BUILD_PAP).
 hpChkNodePointsAssignSp0 :: CmmExpr -> CmmExpr -> Code
 hpChkNodePointsAssignSp0 bytes sp0
-  = do_checks' (CmmLit (mkIntCLit 0)) bytes False True assign stg_gc_enter1
+  = do_checks' (CmmLit (mkIntCLit 0)) bytes False True assign
+          stg_gc_enter1 (Just [node])
   where assign = oneStmt (CmmStore (CmmReg spReg) sp0)
 
 stkChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> Code
 stkChkGen bytes liveness reentry
-  = do_checks' bytes (CmmLit (mkIntCLit 0)) True False assigns stg_gc_gen
+  = do_checks' bytes (CmmLit (mkIntCLit 0)) True False assigns
+          stg_gc_gen (Just activeStgRegs)
   where
     assigns = mkStmts [ mk_vanilla_assignment 9 liveness,
 	    		mk_vanilla_assignment 10 reentry ]
@@ -539,7 +552,8 @@ mk_vanilla_assignment n e
 
 stkChkNodePoints :: CmmExpr -> Code
 stkChkNodePoints bytes
-  = do_checks' bytes (CmmLit (mkIntCLit 0)) True False noStmts stg_gc_enter1
+  = do_checks' bytes (CmmLit (mkIntCLit 0)) True False noStmts
+          stg_gc_enter1 (Just [node])
 
 stg_gc_gen :: CmmExpr
 stg_gc_gen = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_gen")))
diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs
index ed5c5261d7..ee5fb594c7 100644
--- a/compiler/codeGen/CgInfoTbls.hs
+++ b/compiler/codeGen/CgInfoTbls.hs
@@ -232,10 +232,10 @@ emitAlgReturnTarget name branches mb_deflt fam_sz
 		-- global labels, so we can't use them at the 'call site'
 
 --------------------------------
-emitReturnInstr :: Code
-emitReturnInstr 
-  = do 	{ info_amode <- getSequelAmode
-	; stmtC (CmmJump (entryCode info_amode) []) }
+emitReturnInstr :: Maybe [GlobalReg] -> Code
+emitReturnInstr live
+  = do { info_amode <- getSequelAmode
+       ; stmtC (CmmJump (entryCode info_amode) live) }
 
 -----------------------------------------------------------------------------
 --
diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs
index 6e164ce9ee..f907f85071 100644
--- a/compiler/codeGen/CgMonad.lhs
+++ b/compiler/codeGen/CgMonad.lhs
@@ -4,20 +4,19 @@
 %
 \section[CgMonad]{The code generation monad}
 
-See the beginning of the top-level @CodeGen@ module, to see how this
-monadic stuff fits into the Big Picture.
+See the beginning of the top-level @CodeGen@ module, to see how this monadic
+stuff fits into the Big Picture.
 
 \begin{code}
 
 {-# LANGUAGE BangPatterns #-}
 module CgMonad (
-        Code,
-        FCode,
+        Code, FCode,
 
         initC, runC, thenC, thenFC, listCs, listFCs, mapCs, mapFCs,
         returnFC, fixC, fixC_, checkedAbsC, 
         stmtC, stmtsC, labelC, emitStmts, nopC, whenC, newLabelC,
-        newUnique, newUniqSupply, 
+        newUnique, newUniqSupply,
 
         CgStmts, emitCgStmts, forkCgStmts, cgStmtsToBlocks,
         getCgStmts', getCgStmts,
@@ -35,7 +34,7 @@ module CgMonad (
         setEndOfBlockInfo, getEndOfBlockInfo,
 
         setSRT, getSRT,
-        setSRTLabel, getSRTLabel, 
+        setSRTLabel, getSRTLabel,
         setTickyCtrLabel, getTickyCtrLabel,
 
         StackUsage(..), HeapUsage(..),
@@ -48,10 +47,11 @@ module CgMonad (
 
         Sequel(..),
 
-        -- ideally we wouldn't export these, but some other modules access internal state
-        getState, setState, getInfoDown, getDynFlags, getThisPackage, 
+        -- ideally we wouldn't export these, but some other modules access
+        -- internal state
+        getState, setState, getInfoDown, getDynFlags, getThisPackage,
 
-        -- more localised access to monad state 
+        -- more localised access to monad state
         getStkUsage, setStkUsage,
         getBinds, setBinds, getStaticBinds,
 
@@ -92,82 +92,86 @@ infixr 9 `thenFC`
 %*                                                                      *
 %************************************************************************
 
-This monadery has some information that it only passes {\em
-downwards}, as well as some ``state'' which is modified as we go
-along.
+This monadery has some information that it only passes {\em downwards}, as well
+as some ``state'' which is modified as we go along.
 
 \begin{code}
-data CgInfoDownwards    -- information only passed *downwards* by the monad
+
+-- | State only passed *downwards* by the monad
+data CgInfoDownwards
   = MkCgInfoDown {
-        cgd_dflags  :: DynFlags,
-        cgd_mod     :: Module,          -- Module being compiled
-        cgd_statics :: CgBindings,      -- [Id -> info] : static environment
-        cgd_srt_lbl :: CLabel,          -- label of the current SRT
-        cgd_srt     :: SRT,             -- the current SRT
-        cgd_ticky   :: CLabel,          -- current destination for ticky counts
-        cgd_eob     :: EndOfBlockInfo   -- Info for stuff to do at end of basic block:
+        cgd_dflags  :: DynFlags,      -- current flag settings
+        cgd_mod     :: Module,        -- Module being compiled
+        cgd_statics :: CgBindings,    -- [Id -> info] : static environment
+        cgd_srt_lbl :: CLabel,        -- label of the current SRT
+        cgd_srt     :: SRT,           -- the current SRT
+        cgd_ticky   :: CLabel,        -- current destination for ticky counts
+        cgd_eob     :: EndOfBlockInfo -- Info for stuff to do at end of basic block:
   }
 
+-- | Setup initial @CgInfoDownwards@ for the code gen
 initCgInfoDown :: DynFlags -> Module -> CgInfoDownwards
 initCgInfoDown dflags mod
-  = MkCgInfoDown {      cgd_dflags  = dflags,
-                        cgd_mod     = mod,
-                        cgd_statics = emptyVarEnv,
-                        cgd_srt_lbl = error "initC: srt_lbl",
-                        cgd_srt     = error "initC: srt",
-                        cgd_ticky   = mkTopTickyCtrLabel,
-                        cgd_eob     = initEobInfo }
+  = MkCgInfoDown { cgd_dflags  = dflags,
+                   cgd_mod     = mod,
+                   cgd_statics = emptyVarEnv,
+                   cgd_srt_lbl = error "initC: srt_lbl",
+                   cgd_srt     = error "initC: srt",
+                   cgd_ticky   = mkTopTickyCtrLabel,
+                   cgd_eob     = initEobInfo
+  }
 
+-- | State passed around and modified during code generation
 data CgState
   = MkCgState {
-     cgs_stmts :: OrdList CgStmt, -- Current proc
-     cgs_tops  :: OrdList CmmDecl,
-        -- Other procedures and data blocks in this compilation unit
-        -- Both the latter two are ordered only so that we can 
-        -- reduce forward references, when it's easy to do so
-     
-     cgs_binds :: CgBindings,     -- [Id -> info] : *local* bindings environment
-                                  -- Bindings for top-level things are given in
-                                  -- the info-down part
-     
+     cgs_stmts   :: OrdList CgStmt,
+         -- Current proc
+     cgs_tops    :: OrdList CmmDecl,
+         -- Other procedures and data blocks in this compilation unit
+         -- Both the latter two are ordered only so that we can
+         -- reduce forward references, when it's easy to do so
+
+     cgs_binds   :: CgBindings,
+         -- [Id -> info] : *local* bindings environment Bindings for
+         -- top-level things are given in the info-down part
+
      cgs_stk_usg :: StackUsage,
      cgs_hp_usg  :: HeapUsage,
-     
-     cgs_uniqs :: UniqSupply }
+     cgs_uniqs   :: UniqSupply
+  }
 
+-- | Setup initial @CgState@ for the code gen
 initCgState :: UniqSupply -> CgState
 initCgState uniqs
-  = MkCgState { cgs_stmts = nilOL, cgs_tops = nilOL,
-                cgs_binds = emptyVarEnv, 
-                cgs_stk_usg = initStkUsage, 
-                cgs_hp_usg = initHpUsage,
-                cgs_uniqs = uniqs }
-\end{code}
-
-@EndOfBlockInfo@ tells what to do at the end of this block of code or,
-if the expression is a @case@, what to do at the end of each
-alternative.
+  = MkCgState { cgs_stmts   = nilOL,
+                cgs_tops    = nilOL,
+                cgs_binds   = emptyVarEnv,
+                cgs_stk_usg = initStkUsage,
+                cgs_hp_usg  = initHpUsage,
+                cgs_uniqs   = uniqs
+  }
 
-\begin{code}
+-- | @EndOfBlockInfo@ tells what to do at the end of this block of code or, if
+-- the expression is a @case@, what to do at the end of each alternative.
 data EndOfBlockInfo
   = EndOfBlockInfo
-        VirtualSpOffset   -- Args Sp: trim the stack to this point at a
-                          -- return; push arguments starting just
-                          -- above this point on a tail call.
-                          
-                          -- This is therefore the stk ptr as seen
-                          -- by a case alternative.
+        VirtualSpOffset -- Args Sp: trim the stack to this point at a
+                        -- return; push arguments starting just
+                        -- above this point on a tail call.
+                        --
+                        -- This is therefore the stk ptr as seen
+                        -- by a case alternative.
         Sequel
 
+-- | Standard @EndOfBlockInfo@ where the continuation is on the stack
 initEobInfo :: EndOfBlockInfo
 initEobInfo = EndOfBlockInfo 0 OnStack
-\end{code}
 
-Any addressing modes inside @Sequel@ must be ``robust,'' in the sense
-that it must survive stack pointer adjustments at the end of the
-block.
-
-\begin{code}
+-- | @Sequel@ is a representation of the next continuation to jump to
+-- after the current function.
+--
+-- Any addressing modes inside @Sequel@ must be ``robust,'' in the sense
+-- that it must survive stack pointer adjustments at the end of the block.
 data Sequel
   = OnStack          -- Continuation is on the stack
 
@@ -178,9 +182,9 @@ data Sequel
           Id          -- The case binder, only used to see if it's dead
 
 type SemiTaggingStuff
-  = Maybe                   -- Maybe we don't have any semi-tagging stuff...
-     ([(ConTagZ, CmmLit)],  -- Alternatives
-      CmmLit)               -- Default (will be a can't happen RTS label if can't happen)
+  = Maybe                  -- Maybe we don't have any semi-tagging stuff...
+     ([(ConTagZ, CmmLit)], -- Alternatives
+      CmmLit)              -- Default (will be a can't happen RTS label if can't happen)
 
 -- The case branch is executed only from a successful semitagging
 -- venture, when a case has looked at a variable, found that it's
@@ -195,9 +199,9 @@ type SemiTaggingStuff
 %************************************************************************
 
 The CgStmts type is what the code generator outputs: it is a tree of
-statements, including in-line labels.  The job of flattenCgStmts is to
-turn this into a list of basic blocks, each of which ends in a jump
-statement (either a local branch or a non-local jump).
+statements, including in-line labels. The job of flattenCgStmts is to turn
+this into a list of basic blocks, each of which ends in a jump statement
+(either a local branch or a non-local jump).
 
 \begin{code}
 type CgStmts = OrdList CgStmt
@@ -208,7 +212,7 @@ data CgStmt
   | CgFork  BlockId CgStmts
 
 flattenCgStmts :: BlockId -> CgStmts -> [CmmBasicBlock]
-flattenCgStmts id stmts = 
+flattenCgStmts id stmts =
         case flatten (fromOL stmts) of
           ([],blocks)    -> blocks
           (block,blocks) -> BasicBlock id block : blocks
@@ -231,15 +235,15 @@ flattenCgStmts id stmts =
         [CgLabel id]           -> ( [stmt], [BasicBlock id [CmmBranch id]])
         (CgLabel id : stmts)   -> ( [stmt], BasicBlock id block : blocks )
             where (block,blocks) = flatten stmts
-        (CgFork fork_id stmts : ss) -> 
+        (CgFork fork_id stmts : ss) ->
            flatten (CgFork fork_id stmts : CgStmt stmt : ss)
         (CgStmt {} : _) -> panic "CgStmt not seen as ordinary"
 
-  flatten (s:ss) = 
+  flatten (s:ss) =
         case s of
           CgStmt stmt -> (stmt:block,blocks)
           CgLabel id  -> ([CmmBranch id],BasicBlock id block:blocks)
-          CgFork fork_id stmts -> 
+          CgFork fork_id stmts ->
                 (block, BasicBlock fork_id fork_block : fork_blocks ++ blocks)
                 where (fork_block, fork_blocks) = flatten (fromOL stmts)
     where (block,blocks) = flatten ss
@@ -248,7 +252,7 @@ isJump :: CmmStmt -> Bool
 isJump (CmmJump   _ _) = True
 isJump (CmmBranch _  ) = True
 isJump (CmmSwitch _ _) = True
-isJump (CmmReturn _  ) = True
+isJump (CmmReturn    ) = True
 isJump _               = False
 
 isOrdinaryStmt :: CgStmt -> Bool
@@ -263,10 +267,15 @@ isOrdinaryStmt _          = False
 %************************************************************************
 
 \begin{code}
-type VirtualHpOffset = WordOff  -- Both are in
-type VirtualSpOffset = WordOff  -- units of words
+type VirtualHpOffset = WordOff -- Both are in
+type VirtualSpOffset = WordOff -- units of words
 
-data StackUsage 
+-- | Stack usage information during code generation.
+--
+-- INVARIANT: The environment contains no Stable references to
+--            stack slots below (lower offset) frameSp
+--            It can contain volatile references to this area though.
+data StackUsage
   = StackUsage {
         virtSp :: VirtualSpOffset,
                 -- Virtual offset of topmost allocated slot
@@ -277,83 +286,83 @@ data StackUsage
                 -- all the stack from frameSp downwards
                 -- INVARIANT: less than or equal to virtSp
 
-         freeStk :: [VirtualSpOffset], 
+         freeStk :: [VirtualSpOffset],
                 -- List of free slots, in *increasing* order
                 -- INVARIANT: all <= virtSp
-                -- All slots <= virtSp are taken except these ones
+                --            All slots <= virtSp are taken except these ones
 
-         realSp :: VirtualSpOffset,     
+         realSp :: VirtualSpOffset,
                 -- Virtual offset of real stack pointer register
 
          hwSp :: VirtualSpOffset
-  }                -- Highest value ever taken by virtSp
-
--- INVARIANT: The environment contains no Stable references to
---            stack slots below (lower offset) frameSp
---            It can contain volatile references to this area though.
-
-data HeapUsage =
-  HeapUsage {
-        virtHp :: VirtualHpOffset,      -- Virtual offset of highest-allocated word
-        realHp :: VirtualHpOffset       -- realHp: Virtual offset of real heap ptr
+  }             -- Highest value ever taken by virtSp
+
+-- | Heap usage information during code generation.
+--
+-- virtHp keeps track of the next location to allocate an object at. realHp
+-- keeps track of what the Hp STG register actually points to. The reason these
+-- aren't always the same is that we want to be able to move the realHp in one
+-- go when allocating numerous objects to save having to bump it each time.
+-- virtHp we do bump each time but it doesn't create corresponding inefficient
+-- machine code.
+data HeapUsage
+  = HeapUsage {
+        virtHp :: VirtualHpOffset, -- Virtual offset of highest allocated word
+        realHp :: VirtualHpOffset  -- Virtual offset of real heap ptr
   }
-\end{code}
-
-virtHp keeps track of the next location to allocate an object at. realHp keeps
-track of what the Hp STG register actually points to. The reason these aren't
-always the same is that we want to be able to move the realHp in one go when
-allocating numerous objects to save having to bump it each time. virtHp we do
-bump each time but it doesn't create corresponding inefficient machine code.
 
-\begin{code}
+-- | Return the heap usage high water mark
 heapHWM :: HeapUsage -> VirtualHpOffset
 heapHWM = virtHp
-\end{code}
 
-Initialisation.
 
-\begin{code}
+-- | Initial stack usage
 initStkUsage :: StackUsage
-initStkUsage = StackUsage {
-                        virtSp = 0,
-                        frameSp = 0,
-                        freeStk = [],
-                        realSp = 0,
-                        hwSp = 0
-               }
-                
-initHpUsage :: HeapUsage 
-initHpUsage = HeapUsage {
-                virtHp = 0,
-                realHp = 0
-              }
+initStkUsage
+  = StackUsage {
+        virtSp  = 0,
+        frameSp = 0,
+        freeStk = [],
+        realSp  = 0,
+        hwSp    = 0
+  }
+
+-- | Initial heap usage
+initHpUsage :: HeapUsage
+initHpUsage
+  = HeapUsage {
+        virtHp = 0,
+        realHp = 0
+  }
 
 -- | @stateIncUsafe@ sets the stack and heap high water marks of $arg1$ to
 -- be the max of the high water marks of $arg1$ and $arg2$.
 stateIncUsage :: CgState -> CgState -> CgState
 stateIncUsage s1 s2@(MkCgState { cgs_stk_usg = stk_usg, cgs_hp_usg = hp_usg })
-     = s1 { cgs_hp_usg  = cgs_hp_usg  s1 `maxHpHw`  virtHp hp_usg,
-            cgs_stk_usg = cgs_stk_usg s1 `maxStkHw` hwSp   stk_usg }
-       `addCodeBlocksFrom` s2
-                
+  = s1 { cgs_hp_usg  = cgs_hp_usg  s1 `maxHpHw`  virtHp hp_usg,
+         cgs_stk_usg = cgs_stk_usg s1 `maxStkHw` hwSp   stk_usg }
+    `addCodeBlocksFrom` s2
+
+-- | Similar to @stateIncUsafe@ but we don't max the heap high-watermark
+-- because @stateIncUsageEval@ is used only in forkEval, which in turn is only
+-- used for blocks of code which do their own heap-check.
 stateIncUsageEval :: CgState -> CgState -> CgState
 stateIncUsageEval s1 s2
-     = s1 { cgs_stk_usg = cgs_stk_usg s1 `maxStkHw` hwSp (cgs_stk_usg s2) }
-       `addCodeBlocksFrom` s2
-        -- We don't max the heap high-watermark because stateIncUsageEval is
-        -- used only in forkEval, which in turn is only used for blocks of code
-        -- which do their own heap-check.
+  = s1 { cgs_stk_usg = cgs_stk_usg s1 `maxStkHw` hwSp (cgs_stk_usg s2) }
+    `addCodeBlocksFrom` s2
 
+-- | Add code blocks from the latter to the former
+-- (The cgs_stmts will often be empty, but not always; see @codeOnly@)
 addCodeBlocksFrom :: CgState -> CgState -> CgState
--- Add code blocks from the latter to the former
--- (The cgs_stmts will often be empty, but not always; see codeOnly)
 s1 `addCodeBlocksFrom` s2
   = s1 { cgs_stmts = cgs_stmts s1 `appOL` cgs_stmts s2,
          cgs_tops  = cgs_tops  s1 `appOL` cgs_tops  s2 }
 
+-- | Set @HeapUsage@ virtHp to max of current or $arg2$.
 maxHpHw :: HeapUsage -> VirtualHpOffset -> HeapUsage
 hp_usg `maxHpHw` hw = hp_usg { virtHp = virtHp hp_usg `max` hw }
 
+-- | Set @StackUsage@ hwSp to max of current or $arg2$.
 maxStkHw :: StackUsage -> VirtualSpOffset -> StackUsage
 stk_usg `maxStkHw` hw = stk_usg { hwSp = hwSp stk_usg `max` hw }
 \end{code}
@@ -369,15 +378,14 @@ newtype FCode a = FCode (CgInfoDownwards -> CgState -> (a, CgState))
 type Code       = FCode ()
 
 instance Monad FCode where
-        (>>=) = thenFC
+        (>>=)  = thenFC
         return = returnFC
 
 {-# INLINE thenC #-}
 {-# INLINE thenFC #-}
 {-# INLINE returnFC #-}
-\end{code}
-The Abstract~C is not in the environment so as to improve strictness.
 
+<<<<<<< HEAD
 \begin{code}
 initC :: IO CgState
 initC  = do { uniqs <- mkSplitUniqSupply 'c'
@@ -385,35 +393,43 @@ initC  = do { uniqs <- mkSplitUniqSupply 'c'
 
 runC :: DynFlags -> Module -> CgState -> FCode a -> (a,CgState)
 runC dflags mod st (FCode code) = code (initCgInfoDown dflags mod) st
+||||||| merged common ancestors
+\begin{code}
+initC :: DynFlags -> Module -> FCode a -> IO a
+
+initC dflags mod (FCode code)
+  = do  { uniqs <- mkSplitUniqSupply 'c'
+        ; case code (initCgInfoDown dflags mod) (initCgState uniqs) of
+              (res, _) -> return res
+        }
+=======
+initC :: DynFlags -> Module -> FCode a -> IO a
+initC dflags mod (FCode code) = do
+    uniqs <- mkSplitUniqSupply 'c'
+    case code (initCgInfoDown dflags mod) (initCgState uniqs) of
+        (res, _) -> return res
+>>>>>>> origin/master
 
 returnFC :: a -> FCode a
-returnFC val = FCode (\_ state -> (val, state))
-\end{code}
+returnFC val = FCode $ \_ state -> (val, state)
 
-\begin{code}
 thenC :: Code -> FCode a -> FCode a
-thenC (FCode m) (FCode k) = 
-        FCode (\info_down state -> let (_,new_state) = m info_down state in 
-                k info_down new_state)
+thenC (FCode m) (FCode k) = FCode $ \info_down state ->
+    let (_,new_state) = m info_down state
+    in k info_down new_state
 
 listCs :: [Code] -> Code
-listCs [] = return ()
-listCs (fc:fcs) = do
-        fc
-        listCs fcs
-        
+listCs []       = return ()
+listCs (fc:fcs) = fc >> listCs fcs
+
 mapCs :: (a -> Code) -> [a] -> Code
 mapCs = mapM_
 
 thenFC  :: FCode a -> (a -> FCode c) -> FCode c
-thenFC (FCode m) k = FCode (
-        \info_down state ->
-                let 
-                        (m_result, new_state) = m info_down state
-                        (FCode kcode) = k m_result
-                in 
-                        kcode info_down new_state
-        )
+thenFC (FCode m) k = FCode $ \info_down state ->
+    let (m_result, new_state) = m info_down state
+        (FCode kcode)         = k m_result
+    in kcode info_down new_state
 
 listFCs :: [FCode a] -> FCode [a]
 listFCs = sequence
@@ -423,11 +439,10 @@ mapFCs = mapM
 
 -- | Knot-tying combinator for @FCode@
 fixC :: (a -> FCode a) -> FCode a
-fixC fcode = FCode $
-        \info_down state -> 
-                let FCode fc     = fcode v
-                    result@(v,_) = fc info_down state
-                in result
+fixC fcode = FCode $ \info_down state ->
+    let FCode fc     = fcode v
+        result@(v,_) = fc info_down state
+    in result
 
 -- | Knot-tying combinator that throws result away
 fixC_ :: (a -> FCode a) -> FCode ()
@@ -442,241 +457,225 @@ fixC_ fcode = fixC fcode >> return ()
 
 \begin{code}
 getState :: FCode CgState
-getState = FCode $ \_ state -> (state,state)
+getState = FCode $ \_ state -> (state, state)
 
 setState :: CgState -> FCode ()
-setState state = FCode $ \_ _ -> ((),state)
+setState state = FCode $ \_ _ -> ((), state)
 
 getStkUsage :: FCode StackUsage
 getStkUsage = do
-        state <- getState
-        return $ cgs_stk_usg state
+    state <- getState
+    return $ cgs_stk_usg state
 
 setStkUsage :: StackUsage -> Code
 setStkUsage new_stk_usg = do
-        state <- getState
-        setState $ state {cgs_stk_usg = new_stk_usg}
+    state <- getState
+    setState $ state {cgs_stk_usg = new_stk_usg}
 
 getHpUsage :: FCode HeapUsage
 getHpUsage = do
-        state <- getState
-        return $ cgs_hp_usg state
-        
+    state <- getState
+    return $ cgs_hp_usg state
+
 setHpUsage :: HeapUsage -> Code
 setHpUsage new_hp_usg = do
-        state <- getState
-        setState $ state {cgs_hp_usg = new_hp_usg}
+    state <- getState
+    setState $ state {cgs_hp_usg = new_hp_usg}
 
 getBinds :: FCode CgBindings
 getBinds = do
-        state <- getState
-        return $ cgs_binds state
-        
+    state <- getState
+    return $ cgs_binds state
+
 setBinds :: CgBindings -> FCode ()
 setBinds new_binds = do
-        state <- getState
-        setState $ state {cgs_binds = new_binds}
+    state <- getState
+    setState $ state {cgs_binds = new_binds}
 
 getStaticBinds :: FCode CgBindings
 getStaticBinds = do
-        info  <- getInfoDown
-        return (cgd_statics info)
+    info  <- getInfoDown
+    return (cgd_statics info)
 
 withState :: FCode a -> CgState -> FCode (a,CgState)
-withState (FCode fcode) newstate = FCode $ \info_down state -> 
-        let (retval, state2) = fcode info_down newstate in ((retval,state2), state)
+withState (FCode fcode) newstate = FCode $ \info_down state ->
+    let (retval, state2) = fcode info_down newstate
+    in ((retval, state2), state)
 
 newUniqSupply :: FCode UniqSupply
 newUniqSupply = do
-        state <- getState
-        let (us1, us2) = splitUniqSupply (cgs_uniqs state)
-        setState $ state { cgs_uniqs = us1 }
-        return us2
+    state <- getState
+    let (us1, us2) = splitUniqSupply (cgs_uniqs state)
+    setState $ state { cgs_uniqs = us1 }
+    return us2
 
 newUnique :: FCode Unique
 newUnique = do
-        us <- newUniqSupply
-        return (uniqFromSupply us)
+    us <- newUniqSupply
+    return (uniqFromSupply us)
 
 getInfoDown :: FCode CgInfoDownwards
-getInfoDown = FCode $ \info_down state -> (info_down,state)
+getInfoDown = FCode $ \info_down state -> (info_down, state)
 
-getDynFlags :: FCode DynFlags
-getDynFlags = liftM cgd_dflags getInfoDown
+instance HasDynFlags FCode where
+    getDynFlags = liftM cgd_dflags getInfoDown
 
 getThisPackage :: FCode PackageId
 getThisPackage = liftM thisPackage getDynFlags
 
 withInfoDown :: FCode a -> CgInfoDownwards -> FCode a
-withInfoDown (FCode fcode) info_down = FCode $ \_ state -> fcode info_down state 
+withInfoDown (FCode fcode) info_down = FCode $ \_ state -> fcode info_down state
 
 doFCode :: FCode a -> CgInfoDownwards -> CgState -> (a,CgState)
 doFCode (FCode fcode) info_down state = fcode info_down state
 \end{code}
 
-
 %************************************************************************
 %*                                                                      *
                 Forking
 %*                                                                      *
 %************************************************************************
 
-@forkClosureBody@ takes a code, $c$, and compiles it in a completely
-fresh environment, except that:
-        - compilation info and statics are passed in unchanged.
-The current environment is passed on completely unaltered, except that
-abstract C from the fork is incorporated.
-
-@forkProc@ takes a code and compiles it in the current environment,
-returning the basic blocks thus constructed.  The current environment
-is passed on completely unchanged.  It is pretty similar to
-@getBlocks@, except that the latter does affect the environment.
-
-@forkStatics@ $fc$ compiles $fc$ in an environment whose statics come
-from the current bindings, but which is otherwise freshly initialised.
-The Abstract~C returned is attached to the current state, but the
-bindings and usage information is otherwise unchanged.
-
 \begin{code}
+
+-- | Takes code and compiles it in a completely fresh environment, except that
+-- compilation info and statics are passed in unchanged. The current
+-- environment is passed on completely unaltered, except that the Cmm code
+-- from the fork is incorporated.
 forkClosureBody :: Code -> Code
-forkClosureBody body_code
-  = do  { info <- getInfoDown
-        ; us   <- newUniqSupply
-        ; state <- getState
-        ; let   body_info_down = info { cgd_eob = initEobInfo }
-                ((),fork_state) = doFCode body_code body_info_down 
-                                          (initCgState us)
-        ; ASSERT( isNilOL (cgs_stmts fork_state) )
-          setState $ state `addCodeBlocksFrom` fork_state }
-        
+forkClosureBody body_code = do
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+    let body_info_down   = info { cgd_eob = initEobInfo }
+        ((), fork_state) = doFCode body_code body_info_down (initCgState us)
+
+    ASSERT( isNilOL (cgs_stmts fork_state) )
+      setState $ state `addCodeBlocksFrom` fork_state
+
+-- | @forkStatics@ $fc$ compiles $fc$ in an environment whose statics come
+-- from the current bindings, but which is otherwise freshly initialised.
+-- The Cmm returned is attached to the current state, but the bindings and
+-- usage information is otherwise unchanged.
 forkStatics :: FCode a -> FCode a
-forkStatics body_code
-  = do  { info  <- getInfoDown
-        ; us    <- newUniqSupply
-        ; state <- getState
-        ; let   rhs_info_down = info { cgd_statics = cgs_binds state,
-                                       cgd_eob     = initEobInfo }
-                (result, fork_state_out) = doFCode body_code rhs_info_down 
-                                                   (initCgState us)
-        ; ASSERT( isNilOL (cgs_stmts fork_state_out) )
-          setState (state `addCodeBlocksFrom` fork_state_out)
-        ; return result }
-
+forkStatics body_code = do
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+    let rhs_info_down = info { cgd_statics = cgs_binds state,
+                               cgd_eob     = initEobInfo }
+        (result, fork_state_out) = doFCode body_code rhs_info_down (initCgState us)
+
+    ASSERT( isNilOL (cgs_stmts fork_state_out) )
+      setState (state `addCodeBlocksFrom` fork_state_out)
+    return result
+
+-- | @forkProc@ takes a code and compiles it in the current environment,
+-- returning the basic blocks thus constructed. The current environment is
+-- passed on completely unchanged. It is pretty similar to @getBlocks@, except
+-- that the latter does affect the environment.
 forkProc :: Code -> FCode CgStmts
-forkProc body_code
-  = do  { info_down <- getInfoDown
-        ; us    <- newUniqSupply
-        ; state <- getState
-        ; let   fork_state_in = (initCgState us) 
-                                        { cgs_binds   = cgs_binds state,
-                                          cgs_stk_usg = cgs_stk_usg state,
-                                          cgs_hp_usg  = cgs_hp_usg state }
-                        -- ToDo: is the hp usage necesary?
-                (code_blks, fork_state_out) = doFCode (getCgStmts body_code) 
-                                                      info_down fork_state_in
-        ; setState $ state `stateIncUsageEval` fork_state_out
-        ; return code_blks }
+forkProc body_code = do
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+    let fork_state_in = (initCgState us)
+                            { cgs_binds   = cgs_binds state,
+                              cgs_stk_usg = cgs_stk_usg state,
+                              cgs_hp_usg  = cgs_hp_usg state }
+        (code_blks, fork_state_out) = doFCode (getCgStmts body_code)
+                                              info fork_state_in
+    setState $ state `stateIncUsageEval` fork_state_out
+    return code_blks
 
 -- Emit any code from the inner thing into the outer thing
 -- Do not affect anything else in the outer state
 -- Used in almost-circular code to prevent false loop dependencies
 codeOnly :: Code -> Code
-codeOnly body_code
-  = do  { info_down <- getInfoDown
-        ; us   <- newUniqSupply
-        ; state <- getState
-        ; let   fork_state_in = (initCgState us) { cgs_binds   = cgs_binds state,
-                                                   cgs_stk_usg = cgs_stk_usg state,
-                                                   cgs_hp_usg  = cgs_hp_usg state }
-                ((), fork_state_out) = doFCode body_code info_down fork_state_in
-        ; setState $ state `addCodeBlocksFrom` fork_state_out }
-\end{code}
-
-@forkAlts@ $bs~d$ takes fcodes $bs$ for the branches of a @case@, and
-an fcode for the default case $d$, and compiles each in the current
-environment.  The current environment is passed on unmodified, except
-that
-        - the worst stack high-water mark is incorporated
-        - the virtual Hp is moved on to the worst virtual Hp for the branches
-
-\begin{code}
+codeOnly body_code = do
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+    let fork_state_in = (initCgState us) { cgs_binds   = cgs_binds state,
+                                           cgs_stk_usg = cgs_stk_usg state,
+                                           cgs_hp_usg  = cgs_hp_usg state }
+        ((), fork_state_out) = doFCode body_code info fork_state_in
+    setState $ state `addCodeBlocksFrom` fork_state_out
+
+-- | @forkAlts@ $bs~d$ takes fcodes $bs$ for the branches of a @case@, and an
+-- an fcode for the default case $d$, and compiles each in the current
+-- environment. The current environment is passed on unmodified, except that:
+--     * the worst stack high-water mark is incorporated
+--     * the virtual Hp is moved on to the worst virtual Hp for the branches
 forkAlts :: [FCode a] -> FCode [a]
-
-forkAlts branch_fcodes
-  = do  { info_down <- getInfoDown
-        ; us <- newUniqSupply
-        ; state <- getState
-        ; let compile us branch 
-                = (us2, doFCode branch info_down branch_state)
-                where
-                  (us1,us2) = splitUniqSupply us
-                  branch_state = (initCgState us1) {
-                                        cgs_binds   = cgs_binds state,
-                                        cgs_stk_usg = cgs_stk_usg state,
-                                        cgs_hp_usg  = cgs_hp_usg state }
-
-              (_us, results) = mapAccumL compile us branch_fcodes
-              (branch_results, branch_out_states) = unzip results
-        ; setState $ foldl stateIncUsage state branch_out_states
-                -- NB foldl.  state is the *left* argument to stateIncUsage
-        ; return branch_results }
-\end{code}
-
-@forkEval@ takes two blocks of code.
-
-   -  The first meddles with the environment to set it up as expected by
-      the alternatives of a @case@ which does an eval (or gc-possible primop).
-   -  The second block is the code for the alternatives.
-      (plus info for semi-tagging purposes)
-
-@forkEval@ picks up the virtual stack pointer and returns a suitable
-@EndOfBlockInfo@ for the caller to use, together with whatever value
-is returned by the second block.
-
-It uses @initEnvForAlternatives@ to initialise the environment, and
-@stateIncUsageAlt@ to incorporate usage; the latter ignores the heap
-usage.
-
-\begin{code}
-forkEval :: EndOfBlockInfo              -- For the body
-         -> Code                        -- Code to set environment
-         -> FCode Sequel                -- Semi-tagging info to store
-         -> FCode EndOfBlockInfo        -- The new end of block info
-
-forkEval body_eob_info env_code body_code
-  = do  { (v, sequel) <- forkEvalHelp body_eob_info env_code body_code
-        ; returnFC (EndOfBlockInfo v sequel) }
-
+forkAlts branch_fcodes = do 
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+    let compile us branch = (us2, doFCode branch info branch_state)
+            where
+                (us1,us2)    = splitUniqSupply us
+                branch_state = (initCgState us1) {
+                                   cgs_binds   = cgs_binds state,
+                                   cgs_stk_usg = cgs_stk_usg state,
+                                   cgs_hp_usg  = cgs_hp_usg state }
+        (_us, results) = mapAccumL compile us branch_fcodes
+        (branch_results, branch_out_states) = unzip results
+    -- NB foldl. state is the *left* argument to stateIncUsage
+    setState $ foldl stateIncUsage state branch_out_states
+    return branch_results
+
+-- | @forkEval@ takes two blocks of code.
+-- 
+--   *  The first meddles with the environment to set it up as expected by
+--      the alternatives of a @case@ which does an eval (or gc-possible primop).
+--   *  The second block is the code for the alternatives.
+--      (plus info for semi-tagging purposes)
+--
+-- @forkEval@ picks up the virtual stack pointer and returns a suitable
+-- @EndOfBlockInfo@ for the caller to use, together with whatever value
+-- is returned by the second block.
+-- 
+-- It uses @initEnvForAlternatives@ to initialise the environment, and
+-- @stateIncUsageAlt@ to incorporate usage; the latter ignores the heap usage.
+forkEval :: EndOfBlockInfo       -- For the body
+         -> Code                 -- Code to set environment
+         -> FCode Sequel         -- Semi-tagging info to store
+         -> FCode EndOfBlockInfo -- The new end of block info
+forkEval body_eob_info env_code body_code = do
+    (v, sequel) <- forkEvalHelp body_eob_info env_code body_code
+    returnFC (EndOfBlockInfo v sequel)
+
+-- A disturbingly complicated function
 forkEvalHelp :: EndOfBlockInfo  -- For the body
              -> Code            -- Code to set environment
              -> FCode a         -- The code to do after the eval
              -> FCode (VirtualSpOffset, -- Sp
                        a)               -- Result of the FCode
-        -- A disturbingly complicated function
-forkEvalHelp body_eob_info env_code body_code
-  = do  { info_down <- getInfoDown
-        ; us   <- newUniqSupply
-        ; state <- getState
-        ; let { info_down_for_body = info_down {cgd_eob = body_eob_info}
-              ; (_, env_state) = doFCode env_code info_down_for_body 
-                                         (state {cgs_uniqs = us})
-              ; state_for_body = (initCgState (cgs_uniqs env_state)) 
-                                        { cgs_binds   = binds_for_body,
-                                          cgs_stk_usg = stk_usg_for_body }
-              ; binds_for_body   = nukeVolatileBinds (cgs_binds env_state)
-              ; stk_usg_from_env = cgs_stk_usg env_state
-              ; virtSp_from_env  = virtSp stk_usg_from_env
-              ; stk_usg_for_body = stk_usg_from_env {realSp = virtSp_from_env,
-                                                     hwSp   = virtSp_from_env}
-              ; (value_returned, state_at_end_return)
-                        = doFCode body_code info_down_for_body state_for_body           
-          } 
-        ; ASSERT( isNilOL (cgs_stmts state_at_end_return) )
-                 -- The code coming back should consist only of nested declarations,
-                 -- notably of the return vector!
-          setState $ state `stateIncUsageEval` state_at_end_return
-        ; return (virtSp_from_env, value_returned) }
-
+forkEvalHelp body_eob_info env_code body_code = do
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+
+    let info_body      = info { cgd_eob = body_eob_info }
+        (_, env_state) = doFCode env_code info_body
+                                 (state {cgs_uniqs = us})
+        state_for_body = (initCgState (cgs_uniqs env_state))
+                            { cgs_binds   = binds_for_body,
+                              cgs_stk_usg = stk_usg_for_body }
+        binds_for_body   = nukeVolatileBinds (cgs_binds env_state)
+        stk_usg_from_env = cgs_stk_usg env_state
+        virtSp_from_env  = virtSp stk_usg_from_env
+        stk_usg_for_body = stk_usg_from_env { realSp = virtSp_from_env,
+                                              hwSp   = virtSp_from_env }
+        (value_returned, state_at_end_return)
+            = doFCode body_code info_body state_for_body
+
+    -- The code coming back should consist only of nested declarations,
+    -- notably of the return vector!
+    ASSERT( isNilOL (cgs_stmts state_at_end_return) )
+      setState $ state `stateIncUsageEval` state_at_end_return
+    return (virtSp_from_env, value_returned)
 
 -- ----------------------------------------------------------------------------
 -- Combinators for emitting code
@@ -697,20 +696,20 @@ labelC :: BlockId -> Code
 labelC id = emitCgStmt (CgLabel id)
 
 newLabelC :: FCode BlockId
-newLabelC = do { u <- newUnique
-               ; return $ mkBlockId u }
+newLabelC = do
+    u <- newUnique
+    return $ mkBlockId u
 
 -- Emit code, eliminating no-ops
 checkedAbsC :: CmmStmt -> Code
-checkedAbsC stmt = emitStmts (if isNopStmt stmt then nilOL
-                              else unitOL stmt)
+checkedAbsC stmt = emitStmts $ if isNopStmt stmt then nilOL else unitOL stmt
 
 stmtsC :: [CmmStmt] -> Code
-stmtsC stmts = emitStmts (toOL stmts)
+stmtsC stmts = emitStmts $ toOL stmts
 
 -- Emit code; no no-op checking
 emitStmts :: CmmStmts -> Code
-emitStmts stmts = emitCgStmts (fmap CgStmt stmts)
+emitStmts stmts = emitCgStmts $ fmap CgStmt stmts
 
 -- forkLabelledCode is for emitting a chunk of code with a label, outside
 -- of the current instruction stream.
@@ -718,40 +717,64 @@ forkLabelledCode :: Code -> FCode BlockId
 forkLabelledCode code = getCgStmts code >>= forkCgStmts
 
 emitCgStmt :: CgStmt -> Code
-emitCgStmt stmt
-  = do  { state <- getState
-        ; setState $ state { cgs_stmts = cgs_stmts state `snocOL` stmt }
-        }
+emitCgStmt stmt = do
+    state <- getState
+    setState $ state { cgs_stmts = cgs_stmts state `snocOL` stmt }
 
 emitDecl :: CmmDecl -> Code
-emitDecl decl
-  = do  { state <- getState
-        ; setState $ state { cgs_tops = cgs_tops state `snocOL` decl } }
+emitDecl decl = do
+    state <- getState
+    setState $ state { cgs_tops = cgs_tops state `snocOL` decl }
 
+<<<<<<< HEAD
 emitProc :: CmmInfoTable -> CLabel -> [CmmFormal] -> [CmmBasicBlock] -> Code
 emitProc info lbl [] blocks
   = do  { let proc_block = CmmProc info lbl (ListGraph blocks)
         ; state <- getState
         ; setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block } }
+||||||| merged common ancestors
+emitProc :: CmmInfo -> CLabel -> [CmmFormal] -> [CmmBasicBlock] -> Code
+emitProc info lbl [] blocks
+  = do  { let proc_block = CmmProc info lbl (ListGraph blocks)
+        ; state <- getState
+        ; setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block } }
+=======
+emitProc :: CmmInfo -> CLabel -> [CmmFormal] -> [CmmBasicBlock] -> Code
+emitProc info lbl [] blocks = do
+    let proc_block = CmmProc info lbl (ListGraph blocks)
+    state <- getState
+    setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block }
+>>>>>>> origin/master
 emitProc _ _ (_:_) _ = panic "emitProc called with nonempty args"
 
 -- Emit a procedure whose body is the specified code; no info table
 emitSimpleProc :: CLabel -> Code -> Code
+<<<<<<< HEAD
 emitSimpleProc lbl code
   = do  { stmts <- getCgStmts code
         ; blks <- cgStmtsToBlocks stmts
         ; emitProc CmmNonInfoTable lbl [] blks }
+||||||| merged common ancestors
+emitSimpleProc lbl code
+  = do  { stmts <- getCgStmts code
+        ; blks <- cgStmtsToBlocks stmts
+        ; emitProc (CmmInfo Nothing Nothing CmmNonInfoTable) lbl [] blks }
+=======
+emitSimpleProc lbl code = do
+    stmts <- getCgStmts code
+    blks <- cgStmtsToBlocks stmts
+    emitProc (CmmInfo Nothing Nothing CmmNonInfoTable) lbl [] blks
+>>>>>>> origin/master
 
 -- Get all the CmmTops (there should be no stmts)
 -- Return a single Cmm which may be split from other Cmms by
 -- object splitting (at a later stage)
 getCmm :: Code -> FCode CmmGroup
-getCmm code 
-  = do  { state1 <- getState
-        ; ((), state2) <- withState code (state1 { cgs_tops  = nilOL })
-        ; setState $ state2 { cgs_tops = cgs_tops state1 } 
-        ; return (fromOL (cgs_tops state2))
-        }
+getCmm code = do
+    state1 <- getState
+    ((), state2) <- withState code (state1 { cgs_tops  = nilOL })
+    setState $ state2 { cgs_tops = cgs_tops state1 }
+    return (fromOL (cgs_tops state2))
 
 -- ----------------------------------------------------------------------------
 -- CgStmts
@@ -759,38 +782,37 @@ getCmm code
 -- These functions deal in terms of CgStmts, which is an abstract type
 -- representing the code in the current proc.
 
-
 -- emit CgStmts into the current instruction stream
 emitCgStmts :: CgStmts -> Code
-emitCgStmts stmts
-  = do  { state <- getState
-        ; setState $ state { cgs_stmts = cgs_stmts state `appOL` stmts } }
+emitCgStmts stmts = do
+    state <- getState
+    setState $ state { cgs_stmts = cgs_stmts state `appOL` stmts }
 
 -- emit CgStmts outside the current instruction stream, and return a label
 forkCgStmts :: CgStmts -> FCode BlockId
-forkCgStmts stmts
-  = do  { id <- newLabelC
-        ; emitCgStmt (CgFork id stmts)
-        ; return id
-        }
+forkCgStmts stmts = do
+    id <- newLabelC
+    emitCgStmt (CgFork id stmts)
+    return id
 
 -- turn CgStmts into [CmmBasicBlock], for making a new proc.
 cgStmtsToBlocks :: CgStmts -> FCode [CmmBasicBlock]
-cgStmtsToBlocks stmts
-  = do  { id <- newLabelC
-        ; return (flattenCgStmts id stmts)
-        }       
+cgStmtsToBlocks stmts = do
+    id <- newLabelC
+    return (flattenCgStmts id stmts)
 
 -- collect the code emitted by an FCode computation
 getCgStmts' :: FCode a -> FCode (a, CgStmts)
-getCgStmts' fcode
-  = do  { state1 <- getState
-        ; (a, state2) <- withState fcode (state1 { cgs_stmts = nilOL })
-        ; setState $ state2 { cgs_stmts = cgs_stmts state1  }
-        ; return (a, cgs_stmts state2) }
+getCgStmts' fcode = do
+    state1 <- getState
+    (a, state2) <- withState fcode (state1 { cgs_stmts = nilOL })
+    setState $ state2 { cgs_stmts = cgs_stmts state1  }
+    return (a, cgs_stmts state2)
 
 getCgStmts :: FCode a -> FCode CgStmts
-getCgStmts fcode = do { (_,stmts) <- getCgStmts' fcode; return stmts }
+getCgStmts fcode = do
+    (_,stmts) <- getCgStmts' fcode
+    return stmts
 
 -- Simple ways to construct CgStmts:
 noCgStmts :: CgStmts
@@ -806,56 +828,60 @@ consCgStmt stmt stmts = CgStmt stmt `consOL` stmts
 -- Get the current module name
 
 getModuleName :: FCode Module
-getModuleName = do { info <- getInfoDown; return (cgd_mod info) }
+getModuleName = do
+    info <- getInfoDown
+    return (cgd_mod info)
 
 -- ----------------------------------------------------------------------------
 -- Get/set the end-of-block info
 
 setEndOfBlockInfo :: EndOfBlockInfo -> Code -> Code
 setEndOfBlockInfo eob_info code = do
-        info  <- getInfoDown
-        withInfoDown code (info {cgd_eob = eob_info})
+    info  <- getInfoDown
+    withInfoDown code (info {cgd_eob = eob_info})
 
 getEndOfBlockInfo :: FCode EndOfBlockInfo
 getEndOfBlockInfo = do
-        info <- getInfoDown
-        return (cgd_eob info)
+    info <- getInfoDown
+    return (cgd_eob info)
 
 -- ----------------------------------------------------------------------------
 -- Get/set the current SRT label
 
 -- There is just one SRT for each top level binding; all the nested
--- bindings use sub-sections of this SRT.  The label is passed down to
+-- bindings use sub-sections of this SRT. The label is passed down to
 -- the nested bindings via the monad.
 
 getSRTLabel :: FCode CLabel     -- Used only by cgPanic
-getSRTLabel = do info  <- getInfoDown
-                 return (cgd_srt_lbl info)
+getSRTLabel = do
+    info  <- getInfoDown
+    return (cgd_srt_lbl info)
 
 setSRTLabel :: CLabel -> FCode a -> FCode a
-setSRTLabel srt_lbl code
-  = do  info <- getInfoDown
-        withInfoDown code (info { cgd_srt_lbl = srt_lbl})
+setSRTLabel srt_lbl code = do
+    info <- getInfoDown
+    withInfoDown code (info { cgd_srt_lbl = srt_lbl})
 
 getSRT :: FCode SRT
-getSRT = do info <- getInfoDown
-            return (cgd_srt info)
+getSRT = do
+    info <- getInfoDown
+    return (cgd_srt info)
 
 setSRT :: SRT -> FCode a -> FCode a
-setSRT srt code
-  = do info <- getInfoDown
-       withInfoDown code (info { cgd_srt = srt})
+setSRT srt code = do
+    info <- getInfoDown
+    withInfoDown code (info { cgd_srt = srt})
 
 -- ----------------------------------------------------------------------------
 -- Get/set the current ticky counter label
 
 getTickyCtrLabel :: FCode CLabel
 getTickyCtrLabel = do
-        info <- getInfoDown
-        return (cgd_ticky info)
+    info <- getInfoDown
+    return (cgd_ticky info)
 
 setTickyCtrLabel :: CLabel -> Code -> Code
 setTickyCtrLabel ticky code = do
-        info <- getInfoDown
-        withInfoDown code (info {cgd_ticky = ticky})
+    info <- getInfoDown
+    withInfoDown code (info {cgd_ticky = ticky})
 \end{code}
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs
index 3b11054efe..b0865d69d9 100644
--- a/compiler/codeGen/CgPrimOp.hs
+++ b/compiler/codeGen/CgPrimOp.hs
@@ -6,16 +6,9 @@
 --
 -----------------------------------------------------------------------------
 
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module CgPrimOp (
-   cgPrimOp
- ) where
+        cgPrimOp
+    ) where
 
 import BasicTypes
 import ForeignCall
@@ -43,44 +36,44 @@ import StaticFlags
 -- ---------------------------------------------------------------------------
 -- Code generation for PrimOps
 
-cgPrimOp   :: [CmmFormal]	-- where to put the results
-	   -> PrimOp		-- the op
-	   -> [StgArg]		-- arguments
-	   -> StgLiveVars	-- live vars, in case we need to save them
-	   -> Code
+cgPrimOp :: [CmmFormal]       -- where to put the results
+         -> PrimOp            -- the op
+         -> [StgArg]          -- arguments
+         -> StgLiveVars       -- live vars, in case we need to save them
+         -> Code
 
 cgPrimOp results op args live
   = do arg_exprs <- getArgAmodes args
-       let non_void_args = [ e | (r,e) <- arg_exprs, nonVoidArg r ] 
+       let non_void_args = [ e | (r,e) <- arg_exprs, nonVoidArg r ]
        emitPrimOp results op non_void_args live
 
 
-emitPrimOp :: [CmmFormal]	-- where to put the results
-	   -> PrimOp		-- the op
-	   -> [CmmExpr]		-- arguments
-	   -> StgLiveVars	-- live vars, in case we need to save them
-	   -> Code
+emitPrimOp :: [CmmFormal]       -- where to put the results
+           -> PrimOp            -- the op
+           -> [CmmExpr]         -- arguments
+           -> StgLiveVars       -- live vars, in case we need to save them
+           -> Code
 
 --  First we handle various awkward cases specially.  The remaining
 -- easy cases are then handled by translateOp, defined below.
 
 emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] _
-{- 
+{-
    With some bit-twiddling, we can define int{Add,Sub}Czh portably in
    C, and without needing any comparisons.  This may not be the
    fastest way to do it - if you have better code, please send it! --SDM
-  
+
    Return : r = a + b,  c = 0 if no overflow, 1 on overflow.
-  
-   We currently don't make use of the r value if c is != 0 (i.e. 
+
+   We currently don't make use of the r value if c is != 0 (i.e.
    overflow), we just convert to big integers and try again.  This
    could be improved by making r and c the correct values for
-   plugging into a new J#.  
-   
-   { r = ((I_)(a)) + ((I_)(b));					\
-     c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r)))	\
-         >> (BITS_IN (I_) - 1);					\
-   } 
+   plugging into a new J#.
+
+   { r = ((I_)(a)) + ((I_)(b));                                 \
+     c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r)))    \
+         >> (BITS_IN (I_) - 1);                                 \
+   }
    Wading through the mass of bracketry, it seems to reduce to:
    c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1)
 
@@ -88,22 +81,22 @@ emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] _
    = stmtsC [
         CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordAdd [aa,bb]),
         CmmAssign (CmmLocal res_c) $
-	  CmmMachOp mo_wordUShr [
-		CmmMachOp mo_wordAnd [
-		    CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
-		    CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
-		], 
-	        CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
-	  ]
+          CmmMachOp mo_wordUShr [
+                CmmMachOp mo_wordAnd [
+                    CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
+                    CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
+                ],
+                CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
+          ]
      ]
 
 
 emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] _
 {- Similarly:
-   #define subIntCzh(r,c,a,b)					\
-   { r = ((I_)(a)) - ((I_)(b));					\
-     c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r)))	\
-         >> (BITS_IN (I_) - 1);					\
+   #define subIntCzh(r,c,a,b)                                   \
+   { r = ((I_)(a)) - ((I_)(b));                                 \
+     c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r)))     \
+         >> (BITS_IN (I_) - 1);                                 \
    }
 
    c =  ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
@@ -111,27 +104,27 @@ emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] _
    = stmtsC [
         CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordSub [aa,bb]),
         CmmAssign (CmmLocal res_c) $
-	  CmmMachOp mo_wordUShr [
-		CmmMachOp mo_wordAnd [
-		    CmmMachOp mo_wordXor [aa,bb],
-		    CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
-		], 
-	        CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
-	  ]
+          CmmMachOp mo_wordUShr [
+                CmmMachOp mo_wordAnd [
+                    CmmMachOp mo_wordXor [aa,bb],
+                    CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
+                ],
+                CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
+          ]
      ]
 
 
 emitPrimOp [res] ParOp [arg] live
   = do
-	-- for now, just implement this in a C function
-	-- later, we might want to inline it.
+        -- for now, just implement this in a C function
+        -- later, we might want to inline it.
     vols <- getVolatileRegs live
     emitForeignCall' PlayRisky
-	[CmmHinted res NoHint]
-    	(CmmCallee newspark CCallConv) 
-	[   (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
-          , (CmmHinted arg AddrHint)  ] 
-	(Just vols)
+        [CmmHinted res NoHint]
+        (CmmCallee newspark CCallConv)
+        [   (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
+          , (CmmHinted arg AddrHint)  ]
+        (Just vols)
         NoC_SRT -- No SRT b/c we do PlayRisky
         CmmMayReturn
   where
@@ -148,15 +141,15 @@ emitPrimOp [res] SparkOp [arg] live = do
     res' <- newTemp bWord
     emitForeignCall' PlayRisky
         [CmmHinted res' NoHint]
-    	(CmmCallee newspark CCallConv) 
-	[   (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
-          , (CmmHinted arg AddrHint)  ] 
-	(Just vols)
+        (CmmCallee newspark CCallConv)
+        [   (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
+          , (CmmHinted arg AddrHint)  ]
+        (Just vols)
         NoC_SRT -- No SRT b/c we do PlayRisky
         CmmMayReturn
     stmtC (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
   where
-	newspark = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark")))
+        newspark = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark")))
 
 emitPrimOp [res] GetCCSOfOp [arg] _live
   = stmtC (CmmAssign (CmmLocal res) val)
@@ -172,15 +165,15 @@ emitPrimOp [res] ReadMutVarOp [mutv] _
 
 emitPrimOp [] WriteMutVarOp [mutv,var] live
    = do
-	stmtC (CmmStore (cmmOffsetW mutv fixedHdrSize) var)
-	vols <- getVolatileRegs live
-	emitForeignCall' PlayRisky
-		[{-no results-}]
-		(CmmCallee (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
-			 CCallConv)
-		[   (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
+        stmtC (CmmStore (cmmOffsetW mutv fixedHdrSize) var)
+        vols <- getVolatileRegs live
+        emitForeignCall' PlayRisky
+                [{-no results-}]
+                (CmmCallee (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
+                         CCallConv)
+                [   (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
                   , (CmmHinted mutv AddrHint)  ]
-		(Just vols)
+                (Just vols)
                 NoC_SRT -- No SRT b/c we do PlayRisky
                 CmmMayReturn
 
@@ -188,7 +181,7 @@ emitPrimOp [] WriteMutVarOp [mutv,var] live
 --     r = ((StgArrWords *)(a))->bytes
 emitPrimOp [res] SizeofByteArrayOp [arg] _
    = stmtC $
-	CmmAssign (CmmLocal res) (cmmLoadIndexW arg fixedHdrSize bWord)
+        CmmAssign (CmmLocal res) (cmmLoadIndexW arg fixedHdrSize bWord)
 
 --  #define sizzeofMutableByteArrayzh(r,a) \
 --      r = ((StgArrWords *)(a))->bytes
@@ -208,13 +201,13 @@ emitPrimOp [res] ByteArrayContents_Char [arg] _
 emitPrimOp [res] StableNameToIntOp [arg] _
    = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW arg fixedHdrSize bWord))
 
---  #define eqStableNamezh(r,sn1,sn2)					\
+--  #define eqStableNamezh(r,sn1,sn2)                                   \
 --    (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
 emitPrimOp [res] EqStableNameOp [arg1,arg2] _
    = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [
-				cmmLoadIndexW arg1 fixedHdrSize bWord,
-				cmmLoadIndexW arg2 fixedHdrSize bWord
-			 ]))
+                                cmmLoadIndexW arg1 fixedHdrSize bWord,
+                                cmmLoadIndexW arg2 fixedHdrSize bWord
+                         ]))
 
 
 emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2] _
@@ -232,13 +225,13 @@ emitPrimOp [res] DataToTagOp [arg] _
 {- Freezing arrays-of-ptrs requires changing an info table, for the
    benefit of the generational collector.  It needs to scavenge mutable
    objects, even if they are in old space.  When they become immutable,
-   they can be removed from this scavenge list.	 -}
+   they can be removed from this scavenge list.  -}
 
 --  #define unsafeFreezzeArrayzh(r,a)
---	{
+--      {
 --        SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN0_info);
---	  r = a;
---	}
+--        r = a;
+--      }
 emitPrimOp [res] UnsafeFreezeArrayOp [arg] _
    = stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
        CmmAssign (CmmLocal res) arg ]
@@ -246,7 +239,7 @@ emitPrimOp [res] UnsafeFreezeArrayArrayOp [arg] _
    = stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
        CmmAssign (CmmLocal res) arg ]
 
---  #define unsafeFreezzeByteArrayzh(r,a)	r=(a)
+--  #define unsafeFreezzeByteArrayzh(r,a)       r=(a)
 emitPrimOp [res] UnsafeFreezeByteArrayOp [arg] _
    = stmtC (CmmAssign (CmmLocal res) arg)
 
@@ -286,7 +279,7 @@ emitPrimOp []  WriteArrayArrayOp_ArrayArray        [obj,ix,v] _  = doWritePtrArr
 emitPrimOp []  WriteArrayArrayOp_MutableArrayArray [obj,ix,v] _  = doWritePtrArrayOp obj ix v
 
 emitPrimOp [res] SizeofArrayOp [arg] _
-   = stmtC $ 
+   = stmtC $
        CmmAssign (CmmLocal res) (cmmLoadIndexW arg (fixedHdrSize + oFFSET_StgMutArrPtrs_ptrs) bWord)
 emitPrimOp [res] SizeofMutableArrayOp [arg] live
    = emitPrimOp [res] SizeofArrayOp [arg] live
@@ -430,16 +423,16 @@ emitPrimOp [res] op [arg] _
 
    | Just (mop,rep) <- narrowOp op
    = stmtC (CmmAssign (CmmLocal res) $
-	    CmmMachOp (mop rep wordWidth) [CmmMachOp (mop wordWidth rep) [arg]])
+            CmmMachOp (mop rep wordWidth) [CmmMachOp (mop wordWidth rep) [arg]])
 
 emitPrimOp [res] op args live
    | Just prim <- callishOp op
    = do vols <- getVolatileRegs live
-	emitForeignCall' PlayRisky
-	   [CmmHinted res NoHint] 
-	   (CmmPrim prim) 
-	   [CmmHinted a NoHint | a<-args]  -- ToDo: hints?
-	   (Just vols)
+        emitForeignCall' PlayRisky
+           [CmmHinted res NoHint]
+           (CmmPrim prim)
+           [CmmHinted a NoHint | a<-args]  -- ToDo: hints?
+           (Just vols)
            NoC_SRT -- No SRT b/c we do PlayRisky
            CmmMayReturn
 
@@ -458,9 +451,9 @@ nopOp Int2WordOp     = True
 nopOp Word2IntOp     = True
 nopOp Int2AddrOp     = True
 nopOp Addr2IntOp     = True
-nopOp ChrOp	     = True  -- Int# and Char# are rep'd the same
-nopOp OrdOp	     = True
-nopOp _		     = False
+nopOp ChrOp          = True  -- Int# and Char# are rep'd the same
+nopOp OrdOp          = True
+nopOp _              = False
 
 -- These PrimOps turn into double casts
 
@@ -471,7 +464,7 @@ narrowOp Narrow32IntOp  = Just (MO_SS_Conv, W32)
 narrowOp Narrow8WordOp  = Just (MO_UU_Conv, W8)
 narrowOp Narrow16WordOp = Just (MO_UU_Conv, W16)
 narrowOp Narrow32WordOp = Just (MO_UU_Conv, W32)
-narrowOp _ 		= Nothing
+narrowOp _              = Nothing
 
 -- Native word signless ops
 
@@ -494,10 +487,10 @@ translateOp AndOp          = Just mo_wordAnd
 translateOp OrOp           = Just mo_wordOr
 translateOp XorOp          = Just mo_wordXor
 translateOp NotOp          = Just mo_wordNot
-translateOp SllOp	   = Just mo_wordShl
-translateOp SrlOp	   = Just mo_wordUShr
+translateOp SllOp          = Just mo_wordShl
+translateOp SrlOp          = Just mo_wordUShr
 
-translateOp AddrRemOp	   = Just mo_wordURem
+translateOp AddrRemOp      = Just mo_wordURem
 
 -- Native word signed ops
 
@@ -513,9 +506,9 @@ translateOp IntLeOp        = Just mo_wordSLe
 translateOp IntGtOp        = Just mo_wordSGt
 translateOp IntLtOp        = Just mo_wordSLt
 
-translateOp ISllOp	   = Just mo_wordShl
-translateOp ISraOp	   = Just mo_wordSShr
-translateOp ISrlOp	   = Just mo_wordUShr
+translateOp ISllOp         = Just mo_wordShl
+translateOp ISraOp         = Just mo_wordSShr
+translateOp ISrlOp         = Just mo_wordUShr
 
 -- Native word unsigned ops
 
@@ -633,9 +626,9 @@ callishOp _ = Nothing
 -- Helpers for translating various minor variants of array indexing.
 
 -- Bytearrays outside the heap; hence non-pointers
-doIndexOffAddrOp, doIndexByteArrayOp 
-	:: Maybe MachOp -> CmmType 
-	-> [LocalReg] -> [CmmExpr] -> Code
+doIndexOffAddrOp, doIndexByteArrayOp
+        :: Maybe MachOp -> CmmType
+        -> [LocalReg] -> [CmmExpr] -> Code
 doIndexOffAddrOp maybe_post_read_cast rep [res] [addr,idx]
    = mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx
 doIndexOffAddrOp _ _ _ _
@@ -643,7 +636,7 @@ doIndexOffAddrOp _ _ _ _
 
 doIndexByteArrayOp maybe_post_read_cast rep [res] [addr,idx]
    = mkBasicIndexedRead arrWordsHdrSize maybe_post_read_cast rep res addr idx
-doIndexByteArrayOp _ _ _ _ 
+doIndexByteArrayOp _ _ _ _
    = panic "CgPrimOp: doIndexByteArrayOp"
 
 doReadPtrArrayOp :: LocalReg -> CmmExpr -> CmmExpr -> Code
@@ -651,9 +644,9 @@ doReadPtrArrayOp res addr idx
    = mkBasicIndexedRead arrPtrsHdrSize Nothing gcWord res addr idx
 
 
-doWriteOffAddrOp, doWriteByteArrayOp 
-	:: Maybe MachOp -> CmmType 
-	-> [LocalReg] -> [CmmExpr] -> Code
+doWriteOffAddrOp, doWriteByteArrayOp
+        :: Maybe MachOp -> CmmType
+        -> [LocalReg] -> [CmmExpr] -> Code
 doWriteOffAddrOp maybe_pre_write_cast rep [] [addr,idx,val]
    = mkBasicIndexedWrite 0 maybe_pre_write_cast rep addr idx val
 doWriteOffAddrOp _ _ _ _
@@ -661,7 +654,7 @@ doWriteOffAddrOp _ _ _ _
 
 doWriteByteArrayOp maybe_pre_write_cast rep [] [addr,idx,val]
    = mkBasicIndexedWrite arrWordsHdrSize maybe_pre_write_cast rep addr idx val
-doWriteByteArrayOp _ _ _ _ 
+doWriteByteArrayOp _ _ _ _
    = panic "CgPrimOp: doWriteByteArrayOp"
 
 doWritePtrArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> Code
@@ -682,16 +675,16 @@ loadArrPtrsSize :: CmmExpr -> CmmExpr
 loadArrPtrsSize addr = CmmLoad (cmmOffsetB addr off) bWord
  where off = fixedHdrSize*wORD_SIZE + oFFSET_StgMutArrPtrs_ptrs
 
-mkBasicIndexedRead :: ByteOff -> Maybe MachOp -> CmmType 
-		   -> LocalReg -> CmmExpr -> CmmExpr -> Code
+mkBasicIndexedRead :: ByteOff -> Maybe MachOp -> CmmType
+                   -> LocalReg -> CmmExpr -> CmmExpr -> Code
 mkBasicIndexedRead off Nothing read_rep res base idx
    = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexOffExpr off read_rep base idx))
 mkBasicIndexedRead off (Just cast) read_rep res base idx
    = stmtC (CmmAssign (CmmLocal res) (CmmMachOp cast [
-				cmmLoadIndexOffExpr off read_rep base idx]))
+                                cmmLoadIndexOffExpr off read_rep base idx]))
 
-mkBasicIndexedWrite :: ByteOff -> Maybe MachOp -> CmmType 
-		    -> CmmExpr -> CmmExpr -> CmmExpr -> Code
+mkBasicIndexedWrite :: ByteOff -> Maybe MachOp -> CmmType
+                    -> CmmExpr -> CmmExpr -> CmmExpr -> Code
 mkBasicIndexedWrite off Nothing write_rep base idx val
    = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) val)
 mkBasicIndexedWrite off (Just cast) write_rep base idx val
diff --git a/compiler/codeGen/CgTailCall.lhs b/compiler/codeGen/CgTailCall.lhs
index fb8f854c0b..499529d841 100644
--- a/compiler/codeGen/CgTailCall.lhs
+++ b/compiler/codeGen/CgTailCall.lhs
@@ -45,6 +45,7 @@ import Outputable
 import StaticFlags
 
 import Control.Monad
+import Data.Maybe
 
 -----------------------------------------------------------------------------
 -- Tail Calls
@@ -103,17 +104,19 @@ performTailCall fun_info arg_amodes pending_assts
 	   -- to make the heap check easier.  The tail-call sequence
 	   -- is very similar to returning an unboxed tuple, so we
 	   -- share some code.
-     do	{ (final_sp, arg_assts) <- pushUnboxedTuple join_sp arg_amodes
+     do	{ (final_sp, arg_assts, live) <- pushUnboxedTuple join_sp arg_amodes
 	; emitSimultaneously (pending_assts `plusStmts` arg_assts)
 	; let lbl = enterReturnPtLabel (idUnique (cgIdInfoId fun_info))
-	; doFinalJump final_sp True {- Is LNE -} (jumpToLbl lbl) }
+	; doFinalJump final_sp True $ jumpToLbl lbl (Just live) }
 
   | otherwise
   = do 	{ fun_amode <- idInfoToAmode fun_info
 	; let assignSt  = CmmAssign nodeReg fun_amode
               node_asst = oneStmt assignSt
-	      opt_node_asst | nodeMustPointToIt lf_info = node_asst
-			    | otherwise		        = noStmts
+              node_live = Just [node]
+	      (opt_node_asst, opt_node_live)
+                      | nodeMustPointToIt lf_info = (node_asst, node_live)
+                      | otherwise                 = (noStmts, Just [])
 	; EndOfBlockInfo sp _ <- getEndOfBlockInfo
 
 	; dflags <- getDynFlags
@@ -122,8 +125,8 @@ performTailCall fun_info arg_amodes pending_assts
 	    -- Node must always point to things we enter
 	    EnterIt -> do
 		{ emitSimultaneously (node_asst `plusStmts` pending_assts) 
-		; let target     = entryCode (closureInfoPtr (CmmReg nodeReg))
-                      enterClosure = stmtC (CmmJump target [])
+		; let target       = entryCode (closureInfoPtr (CmmReg nodeReg))
+                      enterClosure = stmtC (CmmJump target node_live)
                       -- If this is a scrutinee
                       -- let's check if the closure is a constructor
                       -- so we can directly jump to the alternatives switch
@@ -137,18 +140,18 @@ performTailCall fun_info arg_amodes pending_assts
 	    -- As with any return, Node must point to it.
 	    ReturnIt -> do
 		{ emitSimultaneously (node_asst `plusStmts` pending_assts)
-		; doFinalJump sp False emitReturnInstr }
+		; doFinalJump sp False $ emitReturnInstr node_live }
     
 	    -- A real constructor.  Don't bother entering it, 
 	    -- just do the right sort of return instead.
 	    -- As with any return, Node must point to it.
 	    ReturnCon _ -> do
 		{ emitSimultaneously (node_asst `plusStmts` pending_assts)
-		; doFinalJump sp False emitReturnInstr }
+		; doFinalJump sp False $ emitReturnInstr node_live }
 
 	    JumpToIt lbl -> do
 		{ emitSimultaneously (opt_node_asst `plusStmts` pending_assts)
-		; doFinalJump sp False (jumpToLbl lbl) }
+		; doFinalJump sp False $ jumpToLbl lbl opt_node_live }
     
 	    -- A slow function call via the RTS apply routines
 	    -- Node must definitely point to the thing
@@ -163,7 +166,7 @@ performTailCall fun_info arg_amodes pending_assts
 		; let (apply_lbl, args, extra_args) 
 			= constructSlowCall arg_amodes
 
-		; directCall sp apply_lbl args extra_args 
+		; directCall sp apply_lbl args extra_args node_live
 			(node_asst `plusStmts` pending_assts)
 
 		}
@@ -179,7 +182,7 @@ performTailCall fun_info arg_amodes pending_assts
 		     -- The args beyond the arity go straight on the stack
 		     (arity_args, extra_args) = splitAt arity arg_amodes
      
-		; directCall sp lbl arity_args extra_args
+		; directCall sp lbl arity_args extra_args opt_node_live
 			(opt_node_asst `plusStmts` pending_assts)
 	        }
 	}
@@ -203,7 +206,8 @@ performTailCall fun_info arg_amodes pending_assts
                    -- No, enter the closure.
                    ; enterClosure
                    ; labelC is_constr
-                   ; stmtC (CmmJump (entryCode $ CmmLit (CmmLabel lbl)) [])
+                   ; stmtC (CmmJump (entryCode $
+                               CmmLit (CmmLabel lbl)) (Just [node]))
                    }
 {-
               -- This is a scrutinee for a case expression
@@ -218,7 +222,7 @@ performTailCall fun_info arg_amodes pending_assts
                    ; stmtC (CmmCondBranch (cond1 tag) no_cons)
                    ; stmtC (CmmCondBranch (cond2 tag) no_cons)
                    -- Yes, jump to switch statement
-                   ; stmtC (CmmJump (CmmLit (CmmLabel lbl)) [])
+                   ; stmtC (CmmJump (CmmLit (CmmLabel lbl)))
                    ; labelC no_cons
                    -- No, enter the closure.
                    ; enterClosure
@@ -243,9 +247,9 @@ performTailCall fun_info arg_amodes pending_assts
 -}
 
 directCall :: VirtualSpOffset -> CLabel -> [(CgRep, CmmExpr)]
-           -> [(CgRep, CmmExpr)] -> CmmStmts
+           -> [(CgRep, CmmExpr)] -> Maybe [GlobalReg] -> CmmStmts
            -> Code
-directCall sp lbl args extra_args assts = do
+directCall sp lbl args extra_args live_node assts = do
   let
 	-- First chunk of args go in registers
 	(reg_arg_amodes, stk_args) = assignCallRegs args
@@ -255,14 +259,12 @@ directCall sp lbl args extra_args assts = do
 	slow_stk_args = slowArgs extra_args
 
 	reg_assts = assignToRegs reg_arg_amodes
+        live_args = map snd reg_arg_amodes
+        live_regs = Just $ (fromMaybe [] live_node) ++ live_args
   --
   (final_sp, stk_assts) <- mkStkAmodes sp (stk_args ++ slow_stk_args)
-
-  emitSimultaneously (reg_assts     `plusStmts`
-		      stk_assts     `plusStmts`
-		      assts)
-
-  doFinalJump final_sp False (jumpToLbl lbl)
+  emitSimultaneously $ reg_assts `plusStmts` stk_assts `plusStmts` assts
+  doFinalJump final_sp False $ jumpToLbl lbl live_regs
 
 -- -----------------------------------------------------------------------------
 -- The final clean-up before we do a jump at the end of a basic block.
@@ -296,20 +298,27 @@ performReturn :: Code	-- The code to execute to actually do the return
 
 performReturn finish_code
   = do  { EndOfBlockInfo args_sp _sequel <- getEndOfBlockInfo
-	; doFinalJump args_sp False{-not a LNE-} finish_code }
+	; doFinalJump args_sp False finish_code }
 
 -- ----------------------------------------------------------------------------
 -- Primitive Returns
 -- Just load the return value into the right register, and return.
 
-performPrimReturn :: CgRep -> CmmExpr	-- The thing to return
-		  -> Code
-performPrimReturn rep amode
-  =  do { whenC (not (isVoidArg rep))
-		(stmtC (CmmAssign ret_reg amode))
-	; performReturn emitReturnInstr }
+performPrimReturn :: CgRep -> CmmExpr -> Code
+
+-- non-void return value
+performPrimReturn rep amode | not (isVoidArg rep)
+  = do { stmtC (CmmAssign ret_reg amode)
+       ; performReturn $ emitReturnInstr live_regs }
   where
-    ret_reg = dataReturnConvPrim rep
+    -- careful here as 'dataReturnConvPrim' will panic if given a Void rep
+    ret_reg@(CmmGlobal r) = dataReturnConvPrim rep
+    live_regs = Just [r]
+
+-- void return value
+performPrimReturn _ _
+  = performReturn $ emitReturnInstr (Just [])
+
 
 -- ---------------------------------------------------------------------------
 -- Unboxed tuple returns
@@ -329,19 +338,21 @@ returnUnboxedTuple :: [(CgRep, CmmExpr)] -> Code
 returnUnboxedTuple amodes
   = do 	{ (EndOfBlockInfo args_sp _sequel) <- getEndOfBlockInfo
 	; tickyUnboxedTupleReturn (length amodes)
-	; (final_sp, assts) <- pushUnboxedTuple args_sp amodes
+	; (final_sp, assts, live_regs) <- pushUnboxedTuple args_sp amodes
 	; emitSimultaneously assts
-	; doFinalJump final_sp False{-not a LNE-} emitReturnInstr }
+	; doFinalJump final_sp False $ emitReturnInstr (Just live_regs) }
 
 pushUnboxedTuple :: VirtualSpOffset		-- Sp at which to start pushing
 		 -> [(CgRep, CmmExpr)]		-- amodes of the components
 		 -> FCode (VirtualSpOffset,	-- final Sp
-			   CmmStmts)		-- assignments (regs+stack)
+			   CmmStmts,		-- assignments (regs+stack)
+                           [GlobalReg])         -- registers used (liveness)
 
 pushUnboxedTuple sp [] 
-  = return (sp, noStmts)
+  = return (sp, noStmts, [])
 pushUnboxedTuple sp amodes
   = do	{ let	(reg_arg_amodes, stk_arg_amodes) = assignReturnRegs amodes
+                live_regs = map snd reg_arg_amodes
 	
 		-- separate the rest of the args into pointers and non-pointers
 		(ptr_args, nptr_args) = separateByPtrFollowness stk_arg_amodes
@@ -352,8 +363,8 @@ pushUnboxedTuple sp amodes
 	; (final_sp, nptr_assts) <- mkStkAmodes ptr_sp nptr_args
 
 	; returnFC (final_sp,
-	  	    reg_arg_assts `plusStmts` 
-		    ptr_assts `plusStmts` nptr_assts) }
+	  	    reg_arg_assts `plusStmts` ptr_assts `plusStmts` nptr_assts,
+                    live_regs) }
     
 		  
 -- -----------------------------------------------------------------------------
@@ -403,13 +414,14 @@ tailCallPrim lbl args
 		-- Hence the ASSERT( null leftovers )
 	  arg_amodes <- getArgAmodes args
 	; let (arg_regs, leftovers) = assignPrimOpCallRegs arg_amodes
-	      jump_to_primop = jumpToLbl lbl
+              live_regs = Just $ map snd arg_regs
+	      jump_to_primop = jumpToLbl lbl live_regs
 
 	; ASSERT(null leftovers) -- no stack-resident args
  	  emitSimultaneously (assignToRegs arg_regs)
 
 	; EndOfBlockInfo args_sp _ <- getEndOfBlockInfo
-	; doFinalJump args_sp False{-not a LNE-} jump_to_primop }
+	; doFinalJump args_sp False jump_to_primop }
 
 -- -----------------------------------------------------------------------------
 -- Return Addresses
@@ -438,9 +450,9 @@ pushReturnAddress _ = nopC
 -- -----------------------------------------------------------------------------
 -- Misc.
 
-jumpToLbl :: CLabel -> Code
 -- Passes no argument to the destination procedure
-jumpToLbl lbl = stmtC (CmmJump (CmmLit (CmmLabel lbl)) [{- No args -}])
+jumpToLbl :: CLabel -> Maybe [GlobalReg] -> Code
+jumpToLbl lbl live = stmtC $ CmmJump (CmmLit $ CmmLabel lbl) live
 
 assignToRegs :: [(CmmExpr, GlobalReg)] -> CmmStmts
 assignToRegs reg_args 
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 5274a176a0..2bd35c8796 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -1020,7 +1020,7 @@ fixStgRegStmt stmt
 
         CmmSwitch expr ids -> CmmSwitch (fixStgRegExpr expr) ids
 
-        CmmJump addr regs -> CmmJump (fixStgRegExpr addr) regs
+        CmmJump addr live -> CmmJump (fixStgRegExpr addr) live
 
         -- CmmNop, CmmComment, CmmBranch, CmmReturn
         _other -> stmt
diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs
index ac047edb89..34746984c2 100644
--- a/compiler/codeGen/ClosureInfo.lhs
+++ b/compiler/codeGen/ClosureInfo.lhs
@@ -43,7 +43,7 @@ module ClosureInfo (
         closureFunInfo, isKnownFun,
         funTag, funTagLFInfo, tagForArity, clHasCafRefs,
 
-	enterIdLabel, enterLocalIdLabel, enterReturnPtLabel,
+        enterIdLabel, enterReturnPtLabel,
 
 	nodeMustPointToIt, 
 	CallMethod(..), getCallMethod,
@@ -963,7 +963,10 @@ infoTableLabelFromCI :: ClosureInfo -> CLabel
 infoTableLabelFromCI = fst . labelsFromCI
 
 entryLabelFromCI :: ClosureInfo -> CLabel
-entryLabelFromCI = snd . labelsFromCI
+entryLabelFromCI ci
+  | tablesNextToCode = info_lbl
+  | otherwise        = entry_lbl
+  where (info_lbl, entry_lbl) = labelsFromCI ci
 
 labelsFromCI :: ClosureInfo -> (CLabel, CLabel) -- (Info, Entry)
 labelsFromCI cl@(ClosureInfo { closureName = name,
@@ -1032,11 +1035,6 @@ enterIdLabel id
   | tablesNextToCode = mkInfoTableLabel id
   | otherwise        = mkEntryLabel id
 
-enterLocalIdLabel :: Name -> CafInfo -> CLabel
-enterLocalIdLabel id
-  | tablesNextToCode = mkLocalInfoTableLabel id
-  | otherwise        = mkLocalEntryLabel id
-
 enterReturnPtLabel :: Unique -> CLabel
 enterReturnPtLabel name
   | tablesNextToCode = mkReturnInfoLabel name
diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs
index 3580481043..16edc9c4fb 100644
--- a/compiler/codeGen/StgCmmForeign.hs
+++ b/compiler/codeGen/StgCmmForeign.hs
@@ -247,7 +247,7 @@ nursery_bdescr_blocks = cmmOffset stgCurrentNursery oFFSET_bdescr_blocks
 
 tso_stackobj, tso_CCCS, stack_STACK, stack_SP :: ByteOff
 tso_stackobj = closureField oFFSET_StgTSO_stackobj
-tso_CCCS     = closureField oFFSET_StgTSO_CCCS
+tso_CCCS     = closureField oFFSET_StgTSO_cccs
 stack_STACK  = closureField oFFSET_StgStack_stack
 stack_SP     = closureField oFFSET_StgStack_sp
 
diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs
index c64df7ecc5..ccf0777906 100644
--- a/compiler/codeGen/StgCmmMonad.hs
+++ b/compiler/codeGen/StgCmmMonad.hs
@@ -389,8 +389,8 @@ newUnique = do
 getInfoDown :: FCode CgInfoDownwards
 getInfoDown = FCode $ \info_down state -> (info_down,state)
 
-getDynFlags :: FCode DynFlags
-getDynFlags = liftM cgd_dflags getInfoDown
+instance HasDynFlags FCode where
+    getDynFlags = liftM cgd_dflags getInfoDown
 
 getThisPackage :: FCode PackageId
 getThisPackage = liftM thisPackage getDynFlags
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index 5927faa78e..1824ae9136 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -333,16 +333,36 @@ emitPrimOp [res] FreezeArrayOp [src,src_off,n] =
 emitPrimOp [res] ThawArrayOp [src,src_off,n] =
     emitCloneArray mkMAP_DIRTY_infoLabel res src src_off n
 
+emitPrimOp [] CopyArrayArrayOp [src,src_off,dst,dst_off,n] =
+    doCopyArrayOp src src_off dst dst_off n
+emitPrimOp [] CopyMutableArrayArrayOp [src,src_off,dst,dst_off,n] =
+    doCopyMutableArrayOp src src_off dst dst_off n
+
 -- Reading/writing pointer arrays
 
-emitPrimOp [r] ReadArrayOp  [obj,ix]    = doReadPtrArrayOp r obj ix
-emitPrimOp [r] IndexArrayOp [obj,ix]    = doReadPtrArrayOp r obj ix
+emitPrimOp [res] ReadArrayOp  [obj,ix]    = doReadPtrArrayOp res obj ix
+emitPrimOp [res] IndexArrayOp [obj,ix]    = doReadPtrArrayOp res obj ix
 emitPrimOp []  WriteArrayOp [obj,ix,v]  = doWritePtrArrayOp obj ix v
 
+emitPrimOp [res] IndexArrayArrayOp_ByteArray         [obj,ix]   = doReadPtrArrayOp res obj ix
+emitPrimOp [res] IndexArrayArrayOp_ArrayArray        [obj,ix]   = doReadPtrArrayOp res obj ix
+emitPrimOp [res] ReadArrayArrayOp_ByteArray          [obj,ix]   = doReadPtrArrayOp res obj ix
+emitPrimOp [res] ReadArrayArrayOp_MutableByteArray   [obj,ix]   = doReadPtrArrayOp res obj ix
+emitPrimOp [res] ReadArrayArrayOp_ArrayArray         [obj,ix]   = doReadPtrArrayOp res obj ix
+emitPrimOp [res] ReadArrayArrayOp_MutableArrayArray  [obj,ix]   = doReadPtrArrayOp res obj ix
+emitPrimOp []  WriteArrayArrayOp_ByteArray         [obj,ix,v] = doWritePtrArrayOp obj ix v
+emitPrimOp []  WriteArrayArrayOp_MutableByteArray  [obj,ix,v] = doWritePtrArrayOp obj ix v
+emitPrimOp []  WriteArrayArrayOp_ArrayArray        [obj,ix,v] = doWritePtrArrayOp obj ix v
+emitPrimOp []  WriteArrayArrayOp_MutableArrayArray [obj,ix,v] = doWritePtrArrayOp obj ix v
+
 emitPrimOp [res] SizeofArrayOp [arg]
    = emit $	mkAssign (CmmLocal res) (cmmLoadIndexW arg (fixedHdrSize + oFFSET_StgMutArrPtrs_ptrs) bWord)
 emitPrimOp [res] SizeofMutableArrayOp [arg]
    = emitPrimOp [res] SizeofArrayOp [arg]
+emitPrimOp [res] SizeofArrayArrayOp [arg]
+   = emitPrimOp [res] SizeofArrayOp [arg]
+emitPrimOp [res] SizeofMutableArrayArrayOp [arg]
+   = emitPrimOp [res] SizeofArrayOp [arg]
 
 -- IndexXXXoffAddr