Merging in the new codegen branch

This merge does not turn on the new codegen (which only compiles
a select few programs at this point),
but it does introduce some changes to the old code generator.

The high bits:
1. The Rep Swamp patch is finally here.
   The highlight is that the representation of types at the
   machine level has changed.
   Consequently, this patch contains updates across several back ends.
2. The new Stg -> Cmm path is here, although it appears to have a
   fair number of bugs lurking.
3. Many improvements along the CmmCPSZ path, including:
   o stack layout
   o some code for infotables, half of which is right and half wrong
   o proc-point splitting

1 files changed, 91 insertions, 98 deletions

diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 4de3537788..fd49cb7182 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -20,8 +20,7 @@ module CgUtils (
         emitRODataLits, mkRODataLits,
         emitIf, emitIfThenElse,
 	emitRtsCall, emitRtsCallWithVols, emitRtsCallWithResult,
-	assignNonPtrTemp, newNonPtrTemp,
-	assignPtrTemp, newPtrTemp,
+	assignTemp, newTemp,
 	emitSimultaneously,
 	emitSwitch, emitLitSwitch,
 	tagToClosure,
@@ -47,7 +46,7 @@ module CgUtils (
 	packHalfWordsCLit,
 	blankWord,
 
-	getSRTInfo
+	getSRTInfo, clHasCafRefs
   ) where
 
 #include "HsVersions.h"
@@ -58,13 +57,13 @@ import CgMonad
 import TyCon
 import DataCon
 import Id
+import IdInfo
 import Constants
 import SMRep
 import PprCmm		( {- instances -} )
 import Cmm
 import CLabel
 import CmmUtils
-import MachOp
 import ForeignCall
 import ClosureInfo
 import StgSyn (SRT(..))
@@ -103,24 +102,24 @@ cgLit (MachStr s) = mkByteStringCLit (bytesFS s)
 cgLit other_lit   = return (mkSimpleLit other_lit)
 
 mkSimpleLit :: Literal -> CmmLit
-mkSimpleLit (MachChar	c)    = CmmInt (fromIntegral (ord c)) wordRep
+mkSimpleLit (MachChar	c)    = CmmInt (fromIntegral (ord c)) wordWidth
 mkSimpleLit MachNullAddr      = zeroCLit
-mkSimpleLit (MachInt i)       = CmmInt i wordRep
-mkSimpleLit (MachInt64 i)     = CmmInt i I64
-mkSimpleLit (MachWord i)      = CmmInt i wordRep
-mkSimpleLit (MachWord64 i)    = CmmInt i I64
-mkSimpleLit (MachFloat r)     = CmmFloat r F32
-mkSimpleLit (MachDouble r)    = CmmFloat r F64
+mkSimpleLit (MachInt i)       = CmmInt i wordWidth
+mkSimpleLit (MachInt64 i)     = CmmInt i W64
+mkSimpleLit (MachWord i)      = CmmInt i wordWidth
+mkSimpleLit (MachWord64 i)    = CmmInt i W64
+mkSimpleLit (MachFloat r)     = CmmFloat r W32
+mkSimpleLit (MachDouble r)    = CmmFloat r W64
 mkSimpleLit (MachLabel fs ms) = CmmLabel (mkForeignLabel fs ms is_dyn)
 			      where
 				is_dyn = False	-- ToDo: fix me
 	
 mkLtOp :: Literal -> MachOp
 -- On signed literals we must do a signed comparison
-mkLtOp (MachInt _)    = MO_S_Lt wordRep
-mkLtOp (MachFloat _)  = MO_S_Lt F32
-mkLtOp (MachDouble _) = MO_S_Lt F64
-mkLtOp lit	      = MO_U_Lt (cmmLitRep (mkSimpleLit lit))
+mkLtOp (MachInt _)    = MO_S_Lt wordWidth
+mkLtOp (MachFloat _)  = MO_F_Lt W32
+mkLtOp (MachDouble _) = MO_F_Lt W64
+mkLtOp lit	      = MO_U_Lt (typeWidth (cmmLitType (mkSimpleLit lit)))
 
 
 ---------------------------------------------------
@@ -151,7 +150,7 @@ cmmOffsetLitB = cmmOffsetLit
 cmmOffsetExprW :: CmmExpr -> CmmExpr -> CmmExpr
 -- The second arg is a *word* offset; need to change it to bytes
 cmmOffsetExprW e (CmmLit (CmmInt n _)) = cmmOffsetW e (fromInteger n)
-cmmOffsetExprW e wd_off = cmmIndexExpr wordRep e wd_off
+cmmOffsetExprW e wd_off = cmmIndexExpr wordWidth e wd_off
 
 cmmOffsetW :: CmmExpr -> WordOff -> CmmExpr
 cmmOffsetW e n = cmmOffsetB e (wORD_SIZE * n)
@@ -165,9 +164,8 @@ cmmOffsetLitW lit wd_off = cmmOffsetLitB lit (wORD_SIZE * wd_off)
 cmmLabelOffW :: CLabel -> WordOff -> CmmLit
 cmmLabelOffW lbl wd_off = cmmLabelOffB lbl (wORD_SIZE * wd_off)
 
-cmmLoadIndexW :: CmmExpr -> Int -> CmmExpr
-cmmLoadIndexW base off
-  = CmmLoad (cmmOffsetW base off) wordRep
+cmmLoadIndexW :: CmmExpr -> Int -> CmmType -> CmmExpr
+cmmLoadIndexW base off ty = CmmLoad (cmmOffsetW base off) ty
 
 -----------------------
 cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord :: CmmExpr -> CmmExpr -> CmmExpr
@@ -184,7 +182,7 @@ cmmSubWord e1 e2 = CmmMachOp mo_wordSub [e1, e2]
 
 cmmNegate :: CmmExpr -> CmmExpr
 cmmNegate (CmmLit (CmmInt n rep)) = CmmLit (CmmInt (-n) rep)
-cmmNegate e			  = CmmMachOp (MO_S_Neg (cmmExprRep e)) [e]
+cmmNegate e			  = CmmMachOp (MO_S_Neg (cmmExprWidth e)) [e]
 
 blankWord :: CmmStatic
 blankWord = CmmUninitialised wORD_SIZE
@@ -244,7 +242,7 @@ dataConTagZ con = dataConTag con - fIRST_TAG
 --	Making literals
 
 mkWordCLit :: StgWord -> CmmLit
-mkWordCLit wd = CmmInt (fromIntegral wd) wordRep
+mkWordCLit wd = CmmInt (fromIntegral wd) wordWidth
 
 packHalfWordsCLit :: (Integral a, Integral b) => a -> b -> CmmLit
 -- Make a single word literal in which the lower_half_word is
@@ -267,18 +265,18 @@ packHalfWordsCLit lower_half_word upper_half_word
 --
 --------------------------------------------------------------------------
 
-addToMem :: MachRep 	-- rep of the counter
+addToMem :: Width 	-- rep of the counter
 	 -> CmmExpr	-- Address
 	 -> Int		-- What to add (a word)
 	 -> CmmStmt
-addToMem rep ptr n = addToMemE rep ptr (CmmLit (CmmInt (toInteger n) rep))
+addToMem width ptr n = addToMemE width ptr (CmmLit (CmmInt (toInteger n) width))
 
-addToMemE :: MachRep 	-- rep of the counter
+addToMemE :: Width 	-- rep of the counter
 	  -> CmmExpr	-- Address
 	  -> CmmExpr	-- What to add (a word-typed expression)
 	  -> CmmStmt
-addToMemE rep ptr n
-  = CmmStore ptr (CmmMachOp (MO_Add rep) [CmmLoad ptr rep, n])
+addToMemE width ptr n
+  = CmmStore ptr (CmmMachOp (MO_Add width) [CmmLoad ptr (cmmBits width), n])
 
 -------------------------------------------------------------------------
 --
@@ -289,9 +287,9 @@ addToMemE rep ptr n
 
 tagToClosure :: TyCon -> CmmExpr -> CmmExpr
 tagToClosure tycon tag
-  = CmmLoad (cmmOffsetExprW closure_tbl tag) wordRep
+  = CmmLoad (cmmOffsetExprW closure_tbl tag) gcWord
   where closure_tbl = CmmLit (CmmLabel lbl)
-	lbl = mkClosureTableLabel (tyConName tycon)
+	lbl = mkClosureTableLabel (tyConName tycon) NoCafRefs
 
 -------------------------------------------------------------------------
 --
@@ -334,24 +332,24 @@ emitIfThenElse cond then_part else_part
        ; labelC join_id
        }
 
-emitRtsCall :: LitString -> [CmmKinded CmmExpr] -> Bool -> Code
+emitRtsCall :: LitString -> [CmmHinted CmmExpr] -> Bool -> Code
 emitRtsCall fun args safe = emitRtsCall' [] fun args Nothing safe
    -- The 'Nothing' says "save all global registers"
 
-emitRtsCallWithVols :: LitString -> [CmmKinded CmmExpr] -> [GlobalReg] -> Bool -> Code
+emitRtsCallWithVols :: LitString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code
 emitRtsCallWithVols fun args vols safe
    = emitRtsCall' [] fun args (Just vols) safe
 
-emitRtsCallWithResult :: LocalReg -> MachHint -> LitString
-	-> [CmmKinded CmmExpr] -> Bool -> Code
+emitRtsCallWithResult :: LocalReg -> ForeignHint -> LitString
+	-> [CmmHinted CmmExpr] -> Bool -> Code
 emitRtsCallWithResult res hint fun args safe
-   = emitRtsCall' [CmmKinded res hint] fun args Nothing safe
+   = emitRtsCall' [CmmHinted res hint] fun args Nothing safe
 
 -- Make a call to an RTS C procedure
 emitRtsCall'
-   :: CmmFormals
+   :: [CmmHinted LocalReg]
    -> LitString
-   -> [CmmKinded CmmExpr]
+   -> [CmmHinted CmmExpr]
    -> Maybe [GlobalReg]
    -> Bool -- True <=> CmmSafe call
    -> Code
@@ -393,7 +391,8 @@ callerSaveVolatileRegs vols = (caller_save, caller_load)
 
     vol_list = case vols of Nothing -> all_of_em; Just regs -> regs
 
-    all_of_em = [ VanillaReg n | n <- [0..mAX_Vanilla_REG] ]
+    all_of_em = [ VanillaReg n VNonGcPtr | n <- [0..mAX_Vanilla_REG] ]
+			-- The VNonGcPtr is a lie, but I don't think it matters
 	     ++ [ FloatReg   n | n <- [0..mAX_Float_REG] ]
 	     ++ [ DoubleReg  n | n <- [0..mAX_Double_REG] ]
 	     ++ [ LongReg    n | n <- [0..mAX_Long_REG] ]
@@ -407,7 +406,7 @@ callerSaveVolatileRegs vols = (caller_save, caller_load)
     callerRestoreGlobalReg reg next
 	| callerSaves reg = 
 		CmmAssign (CmmGlobal reg)
-			  (CmmLoad (get_GlobalReg_addr reg) (globalRegRep reg))
+			  (CmmLoad (get_GlobalReg_addr reg) (globalRegType reg))
 			: next
 	| otherwise = next
 
@@ -423,14 +422,14 @@ callerSaveVolatileRegs vols = (caller_save, caller_load)
 get_GlobalReg_addr              :: GlobalReg -> CmmExpr
 get_GlobalReg_addr BaseReg = regTableOffset 0
 get_GlobalReg_addr mid     = get_Regtable_addr_from_offset 
-				(globalRegRep mid) (baseRegOffset mid)
+				(globalRegType mid) (baseRegOffset mid)
 
 -- Calculate a literal representing an offset into the register table.
 -- Used when we don't have an actual BaseReg to offset from.
 regTableOffset n = 
   CmmLit (CmmLabelOff mkMainCapabilityLabel (oFFSET_Capability_r + n))
 
-get_Regtable_addr_from_offset   :: MachRep -> Int -> CmmExpr
+get_Regtable_addr_from_offset   :: CmmType -> Int -> CmmExpr
 get_Regtable_addr_from_offset rep offset =
 #ifdef REG_Base
   CmmRegOff (CmmGlobal BaseReg) offset
@@ -448,28 +447,28 @@ callerSaves :: GlobalReg -> Bool
 callerSaves BaseReg		= True
 #endif
 #ifdef CALLER_SAVES_R1
-callerSaves (VanillaReg 1)	= True
+callerSaves (VanillaReg 1 _)	= True
 #endif
 #ifdef CALLER_SAVES_R2
-callerSaves (VanillaReg 2)	= True
+callerSaves (VanillaReg 2 _)	= True
 #endif
 #ifdef CALLER_SAVES_R3
-callerSaves (VanillaReg 3)	= True
+callerSaves (VanillaReg 3 _)	= True
 #endif
 #ifdef CALLER_SAVES_R4
-callerSaves (VanillaReg 4)	= True
+callerSaves (VanillaReg 4 _)	= True
 #endif
 #ifdef CALLER_SAVES_R5
-callerSaves (VanillaReg 5)	= True
+callerSaves (VanillaReg 5 _)	= True
 #endif
 #ifdef CALLER_SAVES_R6
-callerSaves (VanillaReg 6)	= True
+callerSaves (VanillaReg 6 _)	= True
 #endif
 #ifdef CALLER_SAVES_R7
-callerSaves (VanillaReg 7)	= True
+callerSaves (VanillaReg 7 _)	= True
 #endif
 #ifdef CALLER_SAVES_R8
-callerSaves (VanillaReg 8)	= True
+callerSaves (VanillaReg 8 _)	= True
 #endif
 #ifdef CALLER_SAVES_F1
 callerSaves (FloatReg 1)	= True
@@ -518,16 +517,16 @@ callerSaves _			= False
 
 baseRegOffset :: GlobalReg -> Int
 
-baseRegOffset (VanillaReg 1)      = oFFSET_StgRegTable_rR1
-baseRegOffset (VanillaReg 2)      = oFFSET_StgRegTable_rR2
-baseRegOffset (VanillaReg 3)      = oFFSET_StgRegTable_rR3
-baseRegOffset (VanillaReg 4)      = oFFSET_StgRegTable_rR4
-baseRegOffset (VanillaReg 5)      = oFFSET_StgRegTable_rR5
-baseRegOffset (VanillaReg 6)      = oFFSET_StgRegTable_rR6
-baseRegOffset (VanillaReg 7)      = oFFSET_StgRegTable_rR7
-baseRegOffset (VanillaReg 8)      = oFFSET_StgRegTable_rR8
-baseRegOffset (VanillaReg 9)      = oFFSET_StgRegTable_rR9
-baseRegOffset (VanillaReg 10)     = oFFSET_StgRegTable_rR10
+baseRegOffset (VanillaReg 1 _)    = oFFSET_StgRegTable_rR1
+baseRegOffset (VanillaReg 2 _)    = oFFSET_StgRegTable_rR2
+baseRegOffset (VanillaReg 3 _)    = oFFSET_StgRegTable_rR3
+baseRegOffset (VanillaReg 4 _)    = oFFSET_StgRegTable_rR4
+baseRegOffset (VanillaReg 5 _)    = oFFSET_StgRegTable_rR5
+baseRegOffset (VanillaReg 6 _)    = oFFSET_StgRegTable_rR6
+baseRegOffset (VanillaReg 7 _)    = oFFSET_StgRegTable_rR7
+baseRegOffset (VanillaReg 8 _)    = oFFSET_StgRegTable_rR8
+baseRegOffset (VanillaReg 9 _)    = oFFSET_StgRegTable_rR9
+baseRegOffset (VanillaReg 10 _)   = oFFSET_StgRegTable_rR10
 baseRegOffset (FloatReg  1)       = oFFSET_StgRegTable_rF1
 baseRegOffset (FloatReg  2)       = oFFSET_StgRegTable_rF2
 baseRegOffset (FloatReg  3)       = oFFSET_StgRegTable_rF3
@@ -565,15 +564,15 @@ mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info graph
 mkDataLits lbl lits
   = CmmData Data (CmmDataLabel lbl : map CmmStaticLit lits)
 
-emitRODataLits :: CLabel -> [CmmLit] -> Code
+emitRODataLits :: String -> CLabel -> [CmmLit] -> Code
 -- Emit a read-only data block
-emitRODataLits lbl lits
+emitRODataLits caller lbl lits
   = emitData section (CmmDataLabel lbl : map CmmStaticLit lits)
-  where section | any needsRelocation lits = RelocatableReadOnlyData
-                | otherwise                = ReadOnlyData
-        needsRelocation (CmmLabel _)      = True
-        needsRelocation (CmmLabelOff _ _) = True
-        needsRelocation _                 = False
+    where section | any needsRelocation lits = RelocatableReadOnlyData
+                  | otherwise                = ReadOnlyData
+          needsRelocation (CmmLabel _)      = True
+          needsRelocation (CmmLabelOff _ _) = True
+          needsRelocation _                 = False
 
 mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info graph
 mkRODataLits lbl lits
@@ -602,30 +601,17 @@ mkByteStringCLit bytes
 --
 -------------------------------------------------------------------------
 
-assignNonPtrTemp :: CmmExpr -> FCode CmmExpr
--- For a non-trivial expression, e, create a local
--- variable and assign the expression to it
-assignNonPtrTemp e 
-  | isTrivialCmmExpr e = return e
-  | otherwise 	       = do { reg <- newNonPtrTemp (cmmExprRep e) 
-			    ; stmtC (CmmAssign (CmmLocal reg) e)
-			    ; return (CmmReg (CmmLocal reg)) }
-
-assignPtrTemp :: CmmExpr -> FCode CmmExpr
+assignTemp :: CmmExpr -> FCode CmmExpr
 -- For a non-trivial expression, e, create a local
 -- variable and assign the expression to it
-assignPtrTemp e 
+assignTemp e 
   | isTrivialCmmExpr e = return e
-  | otherwise 	       = do { reg <- newPtrTemp (cmmExprRep e) 
+  | otherwise 	       = do { reg <- newTemp (cmmExprType e) 
 			    ; stmtC (CmmAssign (CmmLocal reg) e)
 			    ; return (CmmReg (CmmLocal reg)) }
 
-newNonPtrTemp :: MachRep -> FCode LocalReg
-newNonPtrTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep GCKindNonPtr) }
-
-newPtrTemp :: MachRep -> FCode LocalReg
-newPtrTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep GCKindPtr) }
-
+newTemp :: CmmType -> FCode LocalReg
+newTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep) }
 
 -------------------------------------------------------------------------
 --
@@ -727,7 +713,7 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C
 
   -- if we can knock off a bunch of default cases with one if, then do so
   | Just deflt <- mb_deflt, (lowest_branch - lo_tag) >= n_branches
-  = do { (assign_tag, tag_expr') <- assignNonPtrTemp' tag_expr
+  = do { (assign_tag, tag_expr') <- assignTemp' tag_expr
        ; let cond = cmmULtWord tag_expr' (CmmLit (mkIntCLit lowest_branch))
 	     branch = CmmCondBranch cond deflt
        ; stmts <- mk_switch tag_expr' branches mb_deflt 
@@ -736,7 +722,7 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C
        }
 
   | Just deflt <- mb_deflt, (hi_tag - highest_branch) >= n_branches
-  = do { (assign_tag, tag_expr') <- assignNonPtrTemp' tag_expr
+  = do { (assign_tag, tag_expr') <- assignTemp' tag_expr
        ; let cond = cmmUGtWord tag_expr' (CmmLit (mkIntCLit highest_branch))
 	     branch = CmmCondBranch cond deflt
        ; stmts <- mk_switch tag_expr' branches mb_deflt 
@@ -745,7 +731,7 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C
        }
 
   | otherwise	-- Use an if-tree
-  = do	{ (assign_tag, tag_expr') <- assignNonPtrTemp' tag_expr
+  = do	{ (assign_tag, tag_expr') <- assignTemp' tag_expr
 		-- To avoid duplication
 	; lo_stmts <- mk_switch tag_expr' lo_branches mb_deflt 
 				lo_tag (mid_tag-1) via_C
@@ -810,9 +796,9 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C
     is_lo (t,_) = t < mid_tag
 
 
-assignNonPtrTemp' e
+assignTemp' e
   | isTrivialCmmExpr e = return (CmmNop, e)
-  | otherwise          = do { reg <- newNonPtrTemp (cmmExprRep e)
+  | otherwise          = do { reg <- newTemp (cmmExprType e)
                             ; return (CmmAssign (CmmLocal reg) e, CmmReg (CmmLocal reg)) }
 
 emitLitSwitch :: CmmExpr			-- Tag to switch on
@@ -828,7 +814,7 @@ emitLitSwitch :: CmmExpr			-- Tag to switch on
 emitLitSwitch scrut [] deflt 
   = emitCgStmts deflt
 emitLitSwitch scrut branches deflt_blk
-  = do	{ scrut' <- assignNonPtrTemp scrut
+  = do	{ scrut' <- assignTemp scrut
 	; deflt_blk_id <- forkCgStmts deflt_blk
 	; blk <- mk_lit_switch scrut' deflt_blk_id (sortLe le branches)
 	; emitCgStmts blk }
@@ -842,8 +828,9 @@ mk_lit_switch scrut deflt_blk_id [(lit,blk)]
   = return (consCgStmt if_stmt blk)
   where
     cmm_lit = mkSimpleLit lit
-    rep     = cmmLitRep cmm_lit
-    cond    = CmmMachOp (MO_Ne rep) [scrut, CmmLit cmm_lit]
+    rep     = cmmLitType cmm_lit
+    ne      = if isFloatType rep then MO_F_Ne else MO_Ne
+    cond    = CmmMachOp (ne (typeWidth rep)) [scrut, CmmLit cmm_lit]
     if_stmt = CmmCondBranch cond deflt_blk_id
 
 mk_lit_switch scrut deflt_blk_id branches
@@ -920,11 +907,11 @@ doSimultaneously1 vertices
 		; stmtC from_temp }
 
 	go_via_temp (CmmAssign dest src)
-	  = do	{ tmp <- newNonPtrTemp (cmmRegRep dest) -- TODO FIXME NOW if the pair of assignments move across a call this will be wrong
+	  = do	{ tmp <- newTemp (cmmRegType dest) -- TODO FIXME NOW if the pair of assignments move across a call this will be wrong
 		; stmtC (CmmAssign (CmmLocal tmp) src)
 		; return (CmmAssign dest (CmmReg (CmmLocal tmp))) }
 	go_via_temp (CmmStore dest src)
-	  = do	{ tmp <- newNonPtrTemp (cmmExprRep src) -- TODO FIXME NOW if the pair of assignemnts move across a call this will be wrong
+	  = do	{ tmp <- newTemp (cmmExprType src) -- TODO FIXME NOW if the pair of assignemnts move across a call this will be wrong
 		; stmtC (CmmAssign (CmmLocal tmp) src)
 		; return (CmmStore dest (CmmReg (CmmLocal tmp))) }
     in
@@ -932,7 +919,7 @@ doSimultaneously1 vertices
 
 mustFollow :: CmmStmt -> CmmStmt -> Bool
 CmmAssign reg _  `mustFollow` stmt = anySrc (reg `regUsedIn`) stmt
-CmmStore loc e   `mustFollow` stmt = anySrc (locUsedIn loc (cmmExprRep e)) stmt
+CmmStore loc e   `mustFollow` stmt = anySrc (locUsedIn loc (cmmExprType e)) stmt
 CmmNop           `mustFollow` stmt = False
 CmmComment _     `mustFollow` stmt = False
 
@@ -952,7 +939,7 @@ reg `regUsedIn` CmmReg reg' 	 = reg == reg'
 reg `regUsedIn` CmmRegOff reg' _ = reg == reg'
 reg `regUsedIn` CmmMachOp _ es   = any (reg `regUsedIn`) es
 
-locUsedIn :: CmmExpr -> MachRep -> CmmExpr -> Bool
+locUsedIn :: CmmExpr -> CmmType -> CmmExpr -> Bool
 -- (locUsedIn a r e) checks whether writing to r[a] could affect the value of
 -- 'e'.  Returns True if it's not sure.
 locUsedIn loc rep (CmmLit _) 	     = False
@@ -961,7 +948,7 @@ locUsedIn loc rep (CmmReg reg')      = False
 locUsedIn loc rep (CmmRegOff reg' _) = False
 locUsedIn loc rep (CmmMachOp _ es)   = any (locUsedIn loc rep) es
 
-possiblySameLoc :: CmmExpr -> MachRep -> CmmExpr -> MachRep -> Bool
+possiblySameLoc :: CmmExpr -> CmmType -> CmmExpr -> CmmType -> Bool
 -- Assumes that distinct registers (eg Hp, Sp) do not 
 -- point to the same location, nor any offset thereof.
 possiblySameLoc (CmmReg r1)       rep1 (CmmReg r2)      rep2  = r1==r2
@@ -970,8 +957,8 @@ possiblySameLoc (CmmRegOff r1 0)  rep1 (CmmReg r2)      rep2  = r1==r2
 possiblySameLoc (CmmRegOff r1 start1) rep1 (CmmRegOff r2 start2) rep2 
   = r1==r2 && end1 > start2 && end2 > start1
   where
-    end1 = start1 + machRepByteWidth rep1
-    end2 = start2 + machRepByteWidth rep2
+    end1 = start1 + widthInBytes (typeWidth rep1)
+    end2 = start2 + widthInBytes (typeWidth rep2)
 
 possiblySameLoc l1 rep1 (CmmLit _) rep2 = False
 possiblySameLoc l1 rep1 l2	   rep2 = True	-- Conservative
@@ -999,7 +986,7 @@ getSRTInfo = do
       | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape]
       -> do id <- newUnique
             let srt_desc_lbl = mkLargeSRTLabel id
-	    emitRODataLits srt_desc_lbl
+	    emitRODataLits "getSRTInfo" srt_desc_lbl
              ( cmmLabelOffW srt_lbl off
 	       : mkWordCLit (fromIntegral len)
 	       : map mkWordCLit bmp)
@@ -1011,3 +998,9 @@ getSRTInfo = do
 		-- The fromIntegral converts to StgHalfWord
 
 srt_escape = (-1) :: StgHalfWord
+
+clHasCafRefs :: ClosureInfo -> CafInfo
+clHasCafRefs (ClosureInfo {closureSRT = srt}) = 
+  case srt of NoC_SRT -> NoCafRefs
+              _       -> MayHaveCafRefs
+clHasCafRefs (ConInfo {}) = NoCafRefs