Snapshot of codegen refactoring to share with simonpj

26 files changed, 559 insertions, 1172 deletions

diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs
index f3013cd5a6..1001969592 100644
--- a/compiler/codeGen/CgCallConv.hs
+++ b/compiler/codeGen/CgCallConv.hs
@@ -11,11 +11,10 @@
 
 module CgCallConv (
 	-- Argument descriptors
-	mkArgDescr, argDescrType,
+	mkArgDescr, 
 
 	-- Liveness
-	isBigLiveness, mkRegLiveness, 
-	smallLiveness, mkLivenessCLit,
+	mkRegLiveness, 
 
 	-- Register assignment
 	assignCallRegs, assignReturnRegs, assignPrimOpCallRegs,
@@ -28,7 +27,6 @@ module CgCallConv (
 	getSequelAmode
     ) where
 
-import CgUtils
 import CgMonad
 import SMRep
 
@@ -36,20 +34,16 @@ import OldCmm
 import CLabel
 
 import Constants
-import ClosureInfo
 import CgStackery
 import OldCmmUtils
 import Maybes
 import Id
 import Name
-import Bitmap
 import Util
 import StaticFlags
 import Module
 import FastString
 import Outputable
-import Unique
-
 import Data.Bits
 
 -------------------------------------------------------------------------
@@ -68,28 +62,16 @@ import Data.Bits
 #include "../includes/rts/storage/FunTypes.h"
 
 -------------------------
-argDescrType :: ArgDescr -> StgHalfWord
--- The "argument type" RTS field type
-argDescrType (ArgSpec n) = n
-argDescrType (ArgGen liveness)
-  | isBigLiveness liveness = ARG_GEN_BIG
-  | otherwise		   = ARG_GEN
-
-
 mkArgDescr :: Name -> [Id] -> FCode ArgDescr
-mkArgDescr nm args 
+mkArgDescr _nm args 
   = case stdPattern arg_reps of
 	Just spec_id -> return (ArgSpec spec_id)
-	Nothing      -> do { liveness <- mkLiveness nm size bitmap
-			   ; return (ArgGen liveness) }
+	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
 
-    bitmap   = mkBitmap arg_bits
-    arg_bits = argBits arg_reps
-    size     = length arg_bits
-
 argBits :: [CgRep] -> [Bool]	-- True for non-ptr, False for ptr
 argBits [] 		= []
 argBits (PtrArg : args) = False : argBits args
@@ -126,52 +108,6 @@ stdPattern _ = Nothing
 
 -------------------------------------------------------------------------
 --
---	Liveness info
---
--------------------------------------------------------------------------
-
--- TODO: This along with 'mkArgDescr' should be unified
--- with 'CmmInfo.mkLiveness'.  However that would require
--- potentially invasive changes to the 'ClosureInfo' type.
--- For now, 'CmmInfo.mkLiveness' handles only continuations and
--- this one handles liveness everything else.  Another distinction
--- between these two is that 'CmmInfo.mkLiveness' information
--- about the stack layout, and this one is information about
--- the heap layout of PAPs.
-mkLiveness :: Name -> Int -> Bitmap -> FCode Liveness
-mkLiveness name size bits
-  | size > mAX_SMALL_BITMAP_SIZE		-- Bitmap does not fit in one word
-  = do	{ let lbl = mkBitmapLabel (getUnique name)
-	; emitRODataLits "mkLiveness" lbl ( mkWordCLit (fromIntegral size)
-		             : map mkWordCLit bits)
-	; return (BigLiveness lbl) }
-  
-  | otherwise		-- Bitmap fits in one word
-  = let
-        small_bits = case bits of 
-			[]  -> 0
-                        [b] -> b
-			_   -> panic "livenessToAddrMode"
-    in
-    return (smallLiveness size small_bits)
-
-smallLiveness :: Int -> StgWord -> Liveness
-smallLiveness size small_bits = SmallLiveness bits
-  where bits = fromIntegral size .|. (small_bits `shiftL` bITMAP_BITS_SHIFT)
-
--------------------
-isBigLiveness :: Liveness -> Bool
-isBigLiveness (BigLiveness _)   = True
-isBigLiveness (SmallLiveness _) = False
-
--------------------
-mkLivenessCLit :: Liveness -> CmmLit
-mkLivenessCLit (BigLiveness lbl)    = CmmLabel lbl
-mkLivenessCLit (SmallLiveness bits) = mkWordCLit bits
-
-
--------------------------------------------------------------------------
---
 --		Bitmap describing register liveness
 --		across GC when doing a "generic" heap check
 --		(a RET_DYN stack frame).
diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs
index 8768008776..33fedfd01b 100644
--- a/compiler/codeGen/CgCon.lhs
+++ b/compiler/codeGen/CgCon.lhs
@@ -402,7 +402,7 @@ For charlike and intlike closures there is a fixed array of static
 closures predeclared.
 
 \begin{code}
-cgTyCon :: TyCon -> FCode [Cmm]  -- each constructor gets a separate Cmm
+cgTyCon :: TyCon -> FCode CmmPgm  -- each constructor gets a separate CmmPgm
 cgTyCon tycon
   = do	{ constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
 
@@ -423,7 +423,7 @@ cgTyCon tycon
 	   else
 		return []
 
-	; return (extra ++ constrs)
+        ; return (concat (extra ++ constrs))
     }
 \end{code}
 
diff --git a/compiler/codeGen/CgExtCode.hs b/compiler/codeGen/CgExtCode.hs
index 12efa03da0..5c56ee0bd5 100644
--- a/compiler/codeGen/CgExtCode.hs
+++ b/compiler/codeGen/CgExtCode.hs
@@ -39,7 +39,7 @@ where
 import CgMonad
 
 import CLabel
-import OldCmm
+import OldCmm hiding( ClosureTypeInfo(..) )
 
 -- import BasicTypes
 import BlockId
@@ -51,11 +51,11 @@ import Unique
 
 -- | The environment contains variable definitions or blockids.
 data Named 	
-	= Var 	CmmExpr		-- ^ Holds CmmLit(CmmLabel ..) which gives the label type,
+	= VarN CmmExpr		-- ^ Holds CmmLit(CmmLabel ..) which gives the label type,
 				--	eg, RtsLabel, ForeignLabel, CmmLabel etc. 
 
-	| Fun	PackageId	-- ^ A function name from this package
-	| Label BlockId		-- ^ A blockid of some code or data.
+	| FunN	 PackageId	-- ^ A function name from this package
+	| LabelN BlockId		-- ^ A blockid of some code or data.
 	
 -- | An environment of named things.
 type Env   	= UniqFM Named
@@ -103,12 +103,12 @@ getEnv 	= EC $ \e s -> return (s, e)
 --	The CmmExpr says where the value is stored. 
 addVarDecl :: FastString -> CmmExpr -> ExtCode
 addVarDecl var expr 
-	= EC $ \_ s -> return ((var, Var expr):s, ())
+	= EC $ \_ s -> return ((var, VarN expr):s, ())
 
 -- | Add a new label to the list of local declarations.
 addLabel :: FastString -> BlockId -> ExtCode
 addLabel name block_id 
-	= EC $ \_ s -> return ((name, Label block_id):s, ())
+	= EC $ \_ s -> return ((name, LabelN block_id):s, ())
 
 
 -- | Create a fresh local variable of a given type.
@@ -139,7 +139,7 @@ newFunctionName
 	-> ExtCode
 	
 newFunctionName name pkg
-	= EC $ \_ s -> return ((name, Fun pkg):s, ())
+	= EC $ \_ s -> return ((name, FunN pkg):s, ())
 	
 	
 -- | Add an imported foreign label to the list of local declarations.
@@ -161,7 +161,7 @@ lookupLabel name = do
   env <- getEnv
   return $ 
      case lookupUFM env name of
-	Just (Label l) 	-> l
+	Just (LabelN l) -> l
 	_other 		-> mkBlockId (newTagUnique (getUnique name) 'L')
 
 
@@ -174,8 +174,8 @@ lookupName name = do
   env    <- getEnv
   return $ 
      case lookupUFM env name of
-	Just (Var e) 	-> e
-	Just (Fun pkg)	-> CmmLit (CmmLabel (mkCmmCodeLabel pkg          name))
+	Just (VarN e) 	-> e
+	Just (FunN pkg)	-> CmmLit (CmmLabel (mkCmmCodeLabel pkg          name))
 	_other 		-> CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId name))
 
 
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index fff21af8cb..73db412bbe 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -29,7 +29,6 @@ import OldCmm
 import OldCmmUtils
 import SMRep
 import ForeignCall
-import ClosureInfo
 import Constants
 import StaticFlags
 import Outputable
diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs
index dbd22f3906..92db95eba8 100644
--- a/compiler/codeGen/CgInfoTbls.hs
+++ b/compiler/codeGen/CgInfoTbls.hs
@@ -9,7 +9,6 @@
 module CgInfoTbls (
 	emitClosureCodeAndInfoTable,
 	emitInfoTableAndCode,
-	dataConTagZ,
 	emitReturnTarget, emitAlgReturnTarget,
 	emitReturnInstr,
 	stdInfoTableSizeB,
@@ -30,12 +29,11 @@ import CgBindery
 import CgCallConv
 import CgUtils
 import CgMonad
+import CmmBuildInfoTables
 
-import OldCmmUtils
 import OldCmm
 import CLabel
 import Name
-import DataCon
 import Unique
 import StaticFlags
 
@@ -59,58 +57,20 @@ emitClosureCodeAndInfoTable cl_info args body
         ; info <- mkCmmInfo cl_info
         ; emitInfoTableAndCode (entryLabelFromCI cl_info) info args blks }
 
--- We keep the *zero-indexed* tag in the srt_len field of the info
--- table of a data constructor.
-dataConTagZ :: DataCon -> ConTagZ
-dataConTagZ con = dataConTag con - fIRST_TAG
-
 -- Convert from 'ClosureInfo' to 'CmmInfo'.
 -- Not used for return points.  (The 'smRepClosureTypeInt' call would panic.)
 mkCmmInfo :: ClosureInfo -> FCode CmmInfo
-mkCmmInfo cl_info = do
-  prof <-
-      if opt_SccProfilingOn
-      then do ty_descr_lit <- mkStringCLit (closureTypeDescr cl_info)
-              cl_descr_lit <- mkStringCLit (closureValDescr cl_info)
-              return $ ProfilingInfo ty_descr_lit cl_descr_lit
-      else return $ ProfilingInfo (mkIntCLit 0) (mkIntCLit 0)
-
-  case cl_info of
-    ConInfo { closureCon = con } -> do
-       cstr <- mkByteStringCLit $ dataConIdentity con
-       let conName = makeRelativeRefTo info_lbl cstr
-           info = ConstrInfo (ptrs, nptrs)
-                             (fromIntegral (dataConTagZ con))
-                             conName
-       return $ CmmInfo gc_target Nothing (CmmInfoTable (infoTableLabelFromCI cl_info) False prof cl_type info)
-
-    ClosureInfo { closureName   = name,
-                  closureLFInfo = lf_info,
-                  closureSRT    = srt } ->
-       return $ CmmInfo gc_target Nothing (CmmInfoTable (infoTableLabelFromCI cl_info) False prof cl_type info)
-       where
-         info =
-             case lf_info of
-               LFReEntrant _ arity _ arg_descr ->
-                   FunInfo (ptrs, nptrs)
-                           srt 
-                           (fromIntegral arity)
-                           arg_descr 
-                           (CmmLabel (mkSlowEntryLabel name has_caf_refs))
-               LFThunk _ _ _ (SelectorThunk offset) _ ->
-                   ThunkSelectorInfo (fromIntegral offset) srt
-               LFThunk _ _ _ _ _ ->
-                   ThunkInfo (ptrs, nptrs) srt
-               _ -> panic "unexpected lambda form in mkCmmInfo"
+mkCmmInfo cl_info
+  = return (CmmInfo gc_target Nothing $
+            CmmInfoTable { cit_lbl  = infoTableLabelFromCI cl_info,
+                   	   cit_rep  = closureSMRep cl_info,
+                   	   cit_prof = prof,
+                   	   cit_srt  = closureSRT cl_info })
   where
-    info_lbl = infoTableLabelFromCI cl_info
-    has_caf_refs = clHasCafRefs cl_info
-
-    cl_type  = smRepClosureTypeInt (closureSMRep cl_info)
-
-    ptrs     = fromIntegral $ closurePtrsSize cl_info
-    size     = fromIntegral $ closureNonHdrSize cl_info
-    nptrs    = size - ptrs
+    prof | not opt_SccProfilingOn = NoProfilingInfo
+         | otherwise = ProfilingInfo ty_descr_w8 val_descr_w8
+    ty_descr_w8  = stringToWord8s (closureTypeDescr cl_info)
+    val_descr_w8 = stringToWord8s (closureValDescr cl_info)
 
     -- The gc_target is to inform the CPS pass when it inserts a stack check.
     -- Since that pass isn't used yet we'll punt for now.
@@ -137,13 +97,12 @@ emitReturnTarget name stmts
   = do	{ srt_info   <- getSRTInfo
 	; blks <- cgStmtsToBlocks stmts
         ; frame <- mkStackLayout
-        ; let info = CmmInfo
-                       gc_target
-                       Nothing
-                       (CmmInfoTable info_lbl False
-                        (ProfilingInfo zeroCLit zeroCLit)
-                        rET_SMALL -- cmmToRawCmm may convert it to rET_BIG
-                        (ContInfo frame srt_info))
+        ; let smrep    = mkStackRep (mkLiveness frame)
+              info     = CmmInfo gc_target Nothing info_tbl
+              info_tbl = CmmInfoTable { cit_lbl  = info_lbl
+                                      , cit_prof = NoProfilingInfo
+                                      , cit_rep  = smrep
+                                      , cit_srt  = srt_info }
         ; emitInfoTableAndCode entry_lbl info args blks
 	; return info_lbl }
   where
@@ -160,7 +119,6 @@ emitReturnTarget name stmts
     -- and stack checks (from the CPS pass).
     gc_target = panic "TODO: gc_target"
 
-
 -- Build stack layout information from the state of the 'FCode' monad.
 -- Should go away once 'codeGen' starts using the CPS conversion
 -- pass to handle the stack.  Until then, this is really just
diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs
index 273c1bf16e..6ee9581087 100644
--- a/compiler/codeGen/CgMonad.lhs
+++ b/compiler/codeGen/CgMonad.lhs
@@ -8,6 +8,7 @@ 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,	-- type
 	FCode,	-- type
@@ -22,7 +23,7 @@ module CgMonad (
 	noCgStmts, oneCgStmt, consCgStmt,
 
 	getCmm,
-	emitData, emitProc, emitSimpleProc,
+	emitDecl, emitProc, emitSimpleProc,
 
 	forkLabelledCode,
 	forkClosureBody, forkStatics, forkAlts, forkEval,
@@ -67,6 +68,7 @@ import OldCmm
 import OldCmmUtils
 import CLabel
 import StgSyn (SRT)
+import ClosureInfo( ConTagZ )
 import SMRep
 import Module
 import Id
@@ -179,8 +181,6 @@ type SemiTaggingStuff
      ([(ConTagZ, CmmLit)],	-- Alternatives
       CmmLit)			-- Default (will be a can't happen RTS label if can't happen)
 
-type ConTagZ = Int	-- A *zero-indexed* contructor tag
-
 -- The case branch is executed only from a successful semitagging
 -- venture, when a case has looked at a variable, found that it's
 -- evaluated, and wants to load up the contents and go to the join
@@ -415,8 +415,8 @@ 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
+                        (m_result, new_state) = m info_down state
+                        (FCode kcode) = k m_result
 		in 
 			kcode info_down new_state
 	)
@@ -736,12 +736,10 @@ emitCgStmt stmt
 	; setState $ state { cgs_stmts = cgs_stmts state `snocOL` stmt }
 	}
 
-emitData :: Section -> CmmStatics -> Code
-emitData sect lits
+emitDecl :: CmmTop -> Code
+emitDecl decl
   = do 	{ state <- getState
-	; setState $ state { cgs_tops = cgs_tops state `snocOL` data_block } }
-  where
-    data_block = CmmData sect lits
+	; setState $ state { cgs_tops = cgs_tops state `snocOL` decl } }
 
 emitProc :: CmmInfo -> CLabel -> [CmmFormal] -> [CmmBasicBlock] -> Code
 emitProc info lbl [] blocks
@@ -757,7 +755,7 @@ emitSimpleProc lbl code
 	; blks <- cgStmtsToBlocks stmts
 	; emitProc (CmmInfo Nothing Nothing CmmNonInfoTable) lbl [] blks }
 
-getCmm :: Code -> FCode Cmm
+getCmm :: Code -> FCode CmmPgm
 -- 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)
@@ -765,7 +763,7 @@ getCmm code
   = do	{ state1 <- getState
 	; ((), state2) <- withState code (state1 { cgs_tops  = nilOL })
 	; setState $ state2 { cgs_tops = cgs_tops state1 } 
-	; return (Cmm (fromOL (cgs_tops state2))) 
+        ; return (fromOL (cgs_tops state2))
         }
 
 -- ----------------------------------------------------------------------------
diff --git a/compiler/codeGen/CgProf.hs b/compiler/codeGen/CgProf.hs
index 243aa1d89a..b58fbb4238 100644
--- a/compiler/codeGen/CgProf.hs
+++ b/compiler/codeGen/CgProf.hs
@@ -294,8 +294,8 @@ emitCostCentreDecl
    :: CostCentre
    -> Code
 emitCostCentreDecl cc = do 
-  { label <- mkStringCLit (costCentreUserName cc)
-  ; modl  <- mkStringCLit (Module.moduleNameString 
+  { label <- newStringCLit (costCentreUserName cc)
+  ; modl  <- newStringCLit (Module.moduleNameString 
                                 (Module.moduleName (cc_mod cc)))
                 -- All cost centres will be in the main package, since we
                 -- don't normally use -auto-all or add SCCs to other packages.
diff --git a/compiler/codeGen/CgTicky.hs b/compiler/codeGen/CgTicky.hs
index 629754fcb5..daeba9274b 100644
--- a/compiler/codeGen/CgTicky.hs
+++ b/compiler/codeGen/CgTicky.hs
@@ -85,8 +85,8 @@ emitTickyCounter :: ClosureInfo -> [Id] -> Int -> Code
 emitTickyCounter cl_info args on_stk
   = ifTicky $
     do	{ mod_name <- getModuleName
-	; fun_descr_lit <- mkStringCLit (fun_descr mod_name)
-	; arg_descr_lit <- mkStringCLit arg_descr
+	; fun_descr_lit <- newStringCLit (fun_descr mod_name)
+	; arg_descr_lit <- newStringCLit arg_descr
 	; emitDataLits ticky_ctr_label 	-- Must match layout of StgEntCounter
 -- krc: note that all the fields are I32 now; some were I16 before, 
 -- but the code generator wasn't handling that properly and it led to chaos, 
@@ -246,18 +246,16 @@ tickyDynAlloc :: ClosureInfo -> Code
 -- Called when doing a dynamic heap allocation
 tickyDynAlloc cl_info
   = ifTicky $
-    case smRepClosureType (closureSMRep cl_info) of
-	Just Constr           -> tick_alloc_con
-	Just ConstrNoCaf      -> tick_alloc_con
-	Just Fun	      -> tick_alloc_fun
-	Just Thunk 	      -> tick_alloc_thk
-	Just ThunkSelector    -> tick_alloc_thk
+    case closureLFInfo cl_info of
+	LFCon {}        -> tick_alloc_con
+	LFReEntrant {}  -> tick_alloc_fun
+	LFThunk {}      -> tick_alloc_thk
         -- black hole
-        Nothing               -> return ()
+        _               -> return ()
   where
 	-- will be needed when we fill in stubs
-    _cl_size   =	closureSize cl_info
-    _slop_size = slopSize cl_info
+    _cl_size   = closureSize cl_info
+--    _slop_size = slopSize cl_info
 
     tick_alloc_thk 
 	| closureUpdReqd cl_info = tick_alloc_up_thk
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 1d2902188c..77f88470a5 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -43,7 +43,7 @@ module CgUtils (
 
 	addToMem, addToMemE,
 	mkWordCLit,
-	mkStringCLit, mkByteStringCLit,
+	newStringCLit, newByteStringCLit,
 	packHalfWordsCLit,
 	blankWord,
 
@@ -98,7 +98,7 @@ addIdReps ids = [(idCgRep id, id) | id <- ids]
 -------------------------------------------------------------------------
 
 cgLit :: Literal -> FCode CmmLit
-cgLit (MachStr s) = mkByteStringCLit (bytesFS s)
+cgLit (MachStr s) = newByteStringCLit (bytesFS s)
  -- not unpackFS; we want the UTF-8 byte stream.
 cgLit other_lit   = return (mkSimpleLit other_lit)
 
@@ -131,88 +131,7 @@ mkLtOp lit	      = MO_U_Lt (typeWidth (cmmLitType (mkSimpleLit lit)))
 --
 ---------------------------------------------------
 
------------------------
--- The "B" variants take byte offsets
-cmmRegOffB :: CmmReg -> ByteOff -> CmmExpr
-cmmRegOffB = cmmRegOff
-
-cmmOffsetB :: CmmExpr -> ByteOff -> CmmExpr
-cmmOffsetB = cmmOffset
-
-cmmOffsetExprB :: CmmExpr -> CmmExpr -> CmmExpr
-cmmOffsetExprB = cmmOffsetExpr
-
-cmmLabelOffB :: CLabel -> ByteOff -> CmmLit
-cmmLabelOffB = cmmLabelOff
-
-cmmOffsetLitB :: CmmLit -> ByteOff -> CmmLit
-cmmOffsetLitB = cmmOffsetLit
-
------------------------
--- The "W" variants take word offsets
-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 wordWidth e wd_off
-
-cmmOffsetW :: CmmExpr -> WordOff -> CmmExpr
-cmmOffsetW e n = cmmOffsetB e (wORD_SIZE * n)
-
-cmmRegOffW :: CmmReg -> WordOff -> CmmExpr
-cmmRegOffW reg wd_off = cmmRegOffB reg (wd_off * wORD_SIZE)
-
-cmmOffsetLitW :: CmmLit -> WordOff -> CmmLit
-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 -> CmmType -> CmmExpr
-cmmLoadIndexW base off ty = CmmLoad (cmmOffsetW base off) ty
-
------------------------
-cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord :: CmmExpr -> CmmExpr -> CmmExpr
-cmmOrWord  e1 e2 = CmmMachOp mo_wordOr  [e1, e2]
-cmmAndWord e1 e2 = CmmMachOp mo_wordAnd [e1, e2]
-cmmNeWord  e1 e2 = CmmMachOp mo_wordNe  [e1, e2]
-cmmEqWord  e1 e2 = CmmMachOp mo_wordEq  [e1, e2]
-cmmULtWord e1 e2 = CmmMachOp mo_wordULt [e1, e2]
-cmmUGeWord e1 e2 = CmmMachOp mo_wordUGe [e1, e2]
-cmmUGtWord e1 e2 = CmmMachOp mo_wordUGt [e1, e2]
---cmmShlWord e1 e2 = CmmMachOp mo_wordShl [e1, e2]
-cmmUShrWord e1 e2 = CmmMachOp mo_wordUShr [e1, e2]
-cmmAddWord e1 e2 = CmmMachOp mo_wordAdd [e1, e2]
-cmmSubWord e1 e2 = CmmMachOp mo_wordSub [e1, e2]
-cmmMulWord e1 e2 = CmmMachOp mo_wordMul [e1, e2]
-
-cmmNegate :: CmmExpr -> CmmExpr
-cmmNegate (CmmLit (CmmInt n rep)) = CmmLit (CmmInt (-n) rep)
-cmmNegate e			  = CmmMachOp (MO_S_Neg (cmmExprWidth e)) [e]
-
-blankWord :: CmmStatic
-blankWord = CmmUninitialised wORD_SIZE
-
--- Tagging --
--- Tag bits mask
---cmmTagBits = CmmLit (mkIntCLit tAG_BITS)
-cmmTagMask = CmmLit (mkIntCLit tAG_MASK)
-cmmPointerMask = CmmLit (mkIntCLit (complement tAG_MASK))
-
--- Used to untag a possibly tagged pointer
--- A static label need not be untagged
-cmmUntag e@(CmmLit (CmmLabel _)) = e
--- Default case
-cmmUntag e = (e `cmmAndWord` cmmPointerMask)
-
-cmmGetTag e = (e `cmmAndWord` cmmTagMask)
-
--- Test if a closure pointer is untagged
-cmmIsTagged e = (e `cmmAndWord` cmmTagMask)
-                 `cmmNeWord` CmmLit zeroCLit
-
-cmmConstrTag e = (e `cmmAndWord` cmmTagMask) `cmmSubWord` (CmmLit (mkIntCLit 1))
--- Get constructor tag, but one based.
-cmmConstrTag1 e = e `cmmAndWord` cmmTagMask
+
 
 {-
    The family size of a data type (the number of constructors)
@@ -237,33 +156,6 @@ tagForCon con = tag
 --Tag an expression, to do: refactor, this appears in some other module.
 tagCons con expr = cmmOffsetB expr (tagForCon con)
 
--- Copied from CgInfoTbls.hs
--- We keep the *zero-indexed* tag in the srt_len field of the info
--- table of a data constructor.
-dataConTagZ :: DataCon -> ConTagZ
-dataConTagZ con = dataConTag con - fIRST_TAG
-
------------------------
---	Making literals
-
-mkWordCLit :: StgWord -> CmmLit
-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
--- at the lower address, and the upper_half_word is at the 
--- higher address
--- ToDo: consider using half-word lits instead
--- 	 but be careful: that's vulnerable when reversed
-packHalfWordsCLit lower_half_word upper_half_word
-#ifdef WORDS_BIGENDIAN
-   = mkWordCLit ((fromIntegral lower_half_word `shiftL` hALF_WORD_SIZE_IN_BITS)
-		 .|. fromIntegral upper_half_word)
-#else 
-   = mkWordCLit ((fromIntegral lower_half_word) 
-		 .|. (fromIntegral upper_half_word `shiftL` hALF_WORD_SIZE_IN_BITS))
-#endif
-
 --------------------------------------------------------------------------
 --
 -- Incrementing a memory location
@@ -544,44 +436,24 @@ baseRegOffset _			  = panic "baseRegOffset:other"
 
 emitDataLits :: CLabel -> [CmmLit] -> Code
 -- Emit a data-segment data block
-emitDataLits lbl lits
-  = emitData Data (Statics lbl $ map CmmStaticLit lits)
-
-mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatics info graph
--- Emit a data-segment data block
-mkDataLits lbl lits
-  = CmmData Data (Statics lbl $ map CmmStaticLit lits)
+emitDataLits lbl lits = emitDecl (mkDataLits Data lbl lits)
 
 emitRODataLits :: String -> CLabel -> [CmmLit] -> Code
 -- Emit a read-only data block
 emitRODataLits caller lbl lits
-  = emitData section (Statics lbl $ map CmmStaticLit lits)
-    where section | any needsRelocation lits = RelocatableReadOnlyData
-                  | otherwise                = ReadOnlyData
-          needsRelocation (CmmLabel _)      = True
-          needsRelocation (CmmLabelOff _ _) = True
-          needsRelocation _                 = False
-
-mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatics info graph
-mkRODataLits lbl lits
-  = CmmData section (Statics lbl $ map CmmStaticLit lits)
-  where section | any needsRelocation lits = RelocatableReadOnlyData
-                | otherwise                = ReadOnlyData
-        needsRelocation (CmmLabel _)      = True
-        needsRelocation (CmmLabelOff _ _) = True
-        needsRelocation _                 = False
-
-mkStringCLit :: String -> FCode CmmLit
+  = emitDecl (mkRODataLits lbl lits)
+
+newStringCLit :: String -> FCode CmmLit
 -- Make a global definition for the string,
 -- and return its label
-mkStringCLit str = mkByteStringCLit (map (fromIntegral.ord) str)
+newStringCLit str = newByteStringCLit (map (fromIntegral.ord) str)
 
-mkByteStringCLit :: [Word8] -> FCode CmmLit
-mkByteStringCLit bytes
+newByteStringCLit :: [Word8] -> FCode CmmLit
+newByteStringCLit bytes
   = do 	{ uniq <- newUnique
-	; let lbl = mkStringLitLabel uniq
-	; emitData ReadOnlyData $ Statics lbl [CmmString bytes]
-	; return (CmmLabel lbl) }
+	; let (lit, decl) = mkByteStringCLit uniq bytes
+	; emitDecl decl
+	; return lit }
 
 -------------------------------------------------------------------------
 --
diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs
index 8bfbfed0bc..443e0ccf89 100644
--- a/compiler/codeGen/ClosureInfo.lhs
+++ b/compiler/codeGen/ClosureInfo.lhs
@@ -17,17 +17,16 @@ module ClosureInfo (
 	StandardFormInfo(..),			-- mkCmmInfo looks inside
         SMRep,
 
-	ArgDescr(..), Liveness(..), 
+	ArgDescr(..), Liveness, 
 	C_SRT(..), needsSRT,
 
 	mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
 	mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
 
 	mkClosureInfo, mkConInfo, maybeIsLFCon,
+        closureSize,
 
-	closureSize, closureNonHdrSize,
-	closureGoodStuffSize, closurePtrsSize,
-	slopSize, 
+	ConTagZ, dataConTagZ,
 
 	infoTableLabelFromCI, entryLabelFromCI,
 	closureLabelFromCI,
@@ -45,7 +44,6 @@ module ClosureInfo (
 	blackHoleOnEntry,
 
 	staticClosureRequired,
-	getClosureType,
 
 	isToplevClosure,
 	closureValDescr, closureTypeDescr,	-- profiling
@@ -63,7 +61,7 @@ import StgSyn
 import SMRep
 
 import CLabel
-
+import Cmm
 import Unique
 import StaticFlags
 import Var
@@ -76,7 +74,6 @@ import TypeRep
 import TcType
 import TyCon
 import BasicTypes
-import FastString
 import Outputable
 import Constants
 import DynFlags
@@ -120,21 +117,6 @@ data ClosureInfo
 	closureCon       :: !DataCon,
 	closureSMRep     :: !SMRep
     }
-
--- C_SRT is what StgSyn.SRT gets translated to... 
--- we add a label for the table, and expect only the 'offset/length' form
-
-data C_SRT = NoC_SRT
-	   | C_SRT !CLabel !WordOff !StgHalfWord {-bitmap or escape-}
-           deriving (Eq)
-
-needsSRT :: C_SRT -> Bool
-needsSRT NoC_SRT       = False
-needsSRT (C_SRT _ _ _) = True
-
-instance Outputable C_SRT where
-  ppr (NoC_SRT) = ptext (sLit "_no_srt_")
-  ppr (C_SRT label off bitmap) = parens (ppr label <> comma <> ppr off <> comma <> text (show bitmap))
 \end{code}
 
 %************************************************************************
@@ -186,33 +168,6 @@ data LambdaFormInfo
 			-- be in the heap, so we make a black hole to hold it.
 
 
--------------------------
--- An ArgDsecr describes the argument pattern of a function
-
-data ArgDescr
-  = ArgSpec		-- Fits one of the standard patterns
-	!StgHalfWord	-- RTS type identifier ARG_P, ARG_N, ...
-
-  | ArgGen	 	-- General case
-	Liveness	-- Details about the arguments
-
-
--------------------------
--- We represent liveness bitmaps as a Bitmap (whose internal
--- representation really is a bitmap).  These are pinned onto case return
--- vectors to indicate the state of the stack for the garbage collector.
--- 
--- In the compiled program, liveness bitmaps that fit inside a single
--- word (StgWord) are stored as a single word, while larger bitmaps are
--- stored as a pointer to an array of words. 
-
-data Liveness
-  = SmallLiveness	-- Liveness info that fits in one word
-	StgWord		-- Here's the bitmap
-
-  | BigLiveness		-- Liveness info witha a multi-word bitmap
-	CLabel		-- Label for the bitmap
-
 
 -------------------------
 -- StandardFormInfo tells whether this thunk has one of 
@@ -320,6 +275,16 @@ isLFThunk LFBlackHole          = True
 isLFThunk _ = False
 \end{code}
 
+\begin{code}
+-- We keep the *zero-indexed* tag in the srt_len field of the info
+-- table of a data constructor.
+type ConTagZ = Int	-- A *zero-indexed* contructor tag
+
+dataConTagZ :: DataCon -> ConTagZ
+dataConTagZ con = dataConTag con - fIRST_TAG
+\end{code}
+
+
 %************************************************************************
 %*									*
 	Building ClosureInfos
@@ -348,7 +313,8 @@ mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr
 		    -- anything else gets eta expanded.
   where
     name   = idName id
-    sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
+    sm_rep = mkHeapRep is_static ptr_wds nonptr_wds (lfClosureType lf_info)
+    nonptr_wds = tot_wds - ptr_wds
 
 mkConInfo :: Bool	-- Is static
 	  -> DataCon	
@@ -358,7 +324,9 @@ mkConInfo is_static data_con tot_wds ptr_wds
    = ConInfo {	closureSMRep = sm_rep,
 		closureCon = data_con }
   where
-    sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
+    sm_rep  = mkHeapRep is_static ptr_wds nonptr_wds (lfClosureType lf_info)
+    lf_info = mkConLFInfo data_con
+    nonptr_wds = tot_wds - ptr_wds
 \end{code}
 
 %************************************************************************
@@ -369,56 +337,10 @@ mkConInfo is_static data_con tot_wds ptr_wds
 
 \begin{code}
 closureSize :: ClosureInfo -> WordOff
-closureSize cl_info = hdr_size + closureNonHdrSize cl_info
-  where hdr_size  | closureIsThunk cl_info = thunkHdrSize
-  		  | otherwise      	   = fixedHdrSize
-	-- All thunks use thunkHdrSize, even if they are non-updatable.
-	-- this is because we don't have separate closure types for
-	-- updatable vs. non-updatable thunks, so the GC can't tell the
-	-- difference.  If we ever have significant numbers of non-
-	-- updatable thunks, it might be worth fixing this.
-
-closureNonHdrSize :: ClosureInfo -> WordOff
-closureNonHdrSize cl_info
-  = tot_wds + computeSlopSize tot_wds cl_info
-  where
-    tot_wds = closureGoodStuffSize cl_info
-
-closureGoodStuffSize :: ClosureInfo -> WordOff
-closureGoodStuffSize cl_info
-  = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)
-    in	ptrs + nonptrs
-
-closurePtrsSize :: ClosureInfo -> WordOff
-closurePtrsSize cl_info
-  = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)
-    in	ptrs
-
--- not exported:
-sizes_from_SMRep :: SMRep -> (WordOff,WordOff)
-sizes_from_SMRep (GenericRep _ ptrs nonptrs _)   = (ptrs, nonptrs)
-sizes_from_SMRep BlackHoleRep			 = (0, 0)
+closureSize cl_info = heapClosureSize (closureSMRep cl_info)
 \end{code}
 
-Computing slop size.  WARNING: this looks dodgy --- it has deep
-knowledge of what the storage manager does with the various
-representations...
-
-Slop Requirements: every thunk gets an extra padding word in the
-header, which takes the the updated value.
-
 \begin{code}
-slopSize :: ClosureInfo -> WordOff
-slopSize cl_info = computeSlopSize payload_size cl_info
-  where payload_size = closureGoodStuffSize cl_info
-
-computeSlopSize :: WordOff -> ClosureInfo -> WordOff
-computeSlopSize payload_size cl_info
-  = max 0 (minPayloadSize smrep updatable - payload_size)
-  where
-	smrep        = closureSMRep cl_info
-	updatable    = closureNeedsUpdSpace cl_info
-
 -- we leave space for an update if either (a) the closure is updatable
 -- or (b) it is a static thunk.  This is because a static thunk needs
 -- a static link field in a predictable place (after the slop), regardless
@@ -427,21 +349,6 @@ closureNeedsUpdSpace :: ClosureInfo -> Bool
 closureNeedsUpdSpace (ClosureInfo { closureLFInfo = 
 					LFThunk TopLevel _ _ _ _ }) = True
 closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
-
-minPayloadSize :: SMRep -> Bool -> WordOff
-minPayloadSize smrep updatable
-  = case smrep of
-	BlackHoleRep		 		-> min_upd_size
-	GenericRep _ _ _ _      | updatable     -> min_upd_size
-	GenericRep True _ _ _                   -> 0 -- static
-	GenericRep False _ _ _                  -> mIN_PAYLOAD_SIZE
-          --       ^^^^^___ dynamic
-  where
-   min_upd_size =
-	ASSERT(mIN_PAYLOAD_SIZE <= sIZEOF_StgSMPThunkHeader)
-	0 	-- check that we already have enough
-		-- room for mIN_SIZE_NonUpdHeapObject,
-		-- due to the extra header word in SMP
 \end{code}
 
 %************************************************************************
@@ -451,33 +358,21 @@ minPayloadSize smrep updatable
 %************************************************************************
 
 \begin{code}
-chooseSMRep
-	:: Bool			-- True <=> static closure
-	-> LambdaFormInfo
-	-> WordOff -> WordOff	-- Tot wds, ptr wds
-	-> SMRep
+lfClosureType :: LambdaFormInfo -> ClosureTypeInfo
+lfClosureType (LFReEntrant _ arity _ argd) = Fun (fromIntegral arity) argd
+lfClosureType (LFCon con)                  = Constr (fromIntegral (dataConTagZ con))
+                                                    (dataConIdentity con)
+lfClosureType (LFThunk _ _ _ is_sel _) 	   = thunkClosureType is_sel
+lfClosureType _                 	   = panic "lfClosureType"
 
-chooseSMRep is_static lf_info tot_wds ptr_wds
-  = let
-	 nonptr_wds   = tot_wds - ptr_wds
-	 closure_type = getClosureType is_static ptr_wds lf_info
-    in
-    GenericRep is_static ptr_wds nonptr_wds closure_type	
+thunkClosureType :: StandardFormInfo -> ClosureTypeInfo
+thunkClosureType (SelectorThunk off) = ThunkSelector (fromIntegral off)
+thunkClosureType _                   = Thunk
 
 -- We *do* get non-updatable top-level thunks sometimes.  eg. f = g
 -- gets compiled to a jump to g (if g has non-zero arity), instead of
 -- messing around with update frames and PAPs.  We set the closure type
 -- to FUN_STATIC in this case.
-
-getClosureType :: Bool -> WordOff -> LambdaFormInfo -> ClosureType
-getClosureType is_static ptr_wds lf_info
-  = case lf_info of
-	LFCon _ | is_static && ptr_wds == 0	-> ConstrNoCaf
-		  | otherwise			-> Constr
-  	LFReEntrant _ _ _ _ 			-> Fun
-	LFThunk _ _ _ (SelectorThunk _) _ 	-> ThunkSelector
-	LFThunk _ _ _ _ _ 			-> Thunk
-	_ -> panic "getClosureType"
 \end{code}
 
 %************************************************************************
@@ -730,13 +625,8 @@ staticClosureNeedsLink :: ClosureInfo -> Bool
 -- of the SRT.
 staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
   = needsSRT srt
-staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
-  = not (isNullaryRepDataCon con) && not_nocaf_constr
-  where
-    not_nocaf_constr = 
-	case sm_rep of 
-	   GenericRep _ _ _ ConstrNoCaf -> False
-	   _other			-> True
+staticClosureNeedsLink (ConInfo { closureSMRep = rep })
+  = not (isStaticNoCafCon rep)
 \end{code}
 
 Note [Entering error thunks]
@@ -1020,7 +910,7 @@ cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
 				       closureType = ty })
   = ClosureInfo { closureName   = nm,
 		  closureLFInfo = LFBlackHole,
-		  closureSMRep  = BlackHoleRep,
+		  closureSMRep  = blackHoleRep,
 		  closureSRT    = NoC_SRT,
 		  closureType   = ty,
 		  closureDescr  = "",
diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs
index 42c4bd24fc..b22e6ed64d 100644
--- a/compiler/codeGen/CodeGen.lhs
+++ b/compiler/codeGen/CodeGen.lhs
@@ -53,7 +53,7 @@ codeGen :: DynFlags
         -> CollectedCCs         -- (Local/global) cost-centres needing declaring/registering.
 	-> [(StgBinding,[(Id,[Id])])]	-- Bindings to convert, with SRTs
 	-> HpcInfo
-	-> IO [Cmm]		-- Output
+        -> IO [CmmPgm]          -- Output
 
                 -- N.B. returning '[Cmm]' and not 'Cmm' here makes it
                 -- possible for object splitting to split up the
@@ -71,7 +71,7 @@ codeGen dflags this_mod data_tycons cost_centre_info stg_binds hpc_info
 		; cmm_tycons <- mapM cgTyCon data_tycons
 		; cmm_init   <- getCmm (mkModuleInit dflags cost_centre_info 
                                              this_mod hpc_info)
-                ; return (cmm_init : cmm_binds ++ concat cmm_tycons)
+                ; return (cmm_init : cmm_binds ++ cmm_tycons)
 		}
 		-- Put datatype_stuff after code_stuff, because the
 		-- datatype closure table (for enumeration types) to
@@ -105,7 +105,7 @@ mkModuleInit dflags cost_centre_info this_mod hpc_info
 
             -- For backwards compatibility: user code may refer to this
             -- label for calling hs_add_root().
-        ; emitData Data $ Statics (mkPlainModuleInitLabel this_mod) []
+        ; emitDecl (CmmData Data (Statics (mkPlainModuleInitLabel this_mod) []))
 
         ; whenC (this_mod == mainModIs dflags) $
              emitSimpleProc (mkPlainModuleInitLabel rOOT_MAIN) $ return ()
diff --git a/compiler/codeGen/SMRep.lhs b/compiler/codeGen/SMRep.lhs
index f35118d1c9..fea9e4b2fc 100644
--- a/compiler/codeGen/SMRep.lhs
+++ b/compiler/codeGen/SMRep.lhs
@@ -28,15 +28,25 @@ module SMRep (
 	typeCgRep, idCgRep, tyConCgRep, 
 
 	-- Closure repesentation
-	SMRep(..), ClosureType(..),
-	isStaticRep,
-	fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize,
-	profHdrSize, thunkHdrSize,
-	smRepClosureType, smRepClosureTypeInt,
-
-	rET_SMALL, rET_BIG
+        SMRep(..),	-- CmmInfo sees the rep; no one else does
+        IsStatic, 
+        ClosureTypeInfo(..), ArgDescr(..), Liveness,
+        ConstrDescription, 
+	mkHeapRep, blackHoleRep, mkStackRep,
+
+	isStaticRep, isStaticNoCafCon,
+        heapClosureSize,
+        fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize,
+        profHdrSize, thunkHdrSize, nonHdrSize,
+
+	rtsClosureType,	rET_SMALL, rET_BIG,
+        aRG_GEN, aRG_GEN_BIG,
+
+	-- Operations over [Word8] strings
+	pprWord8String, stringToWord8s
     ) where
 
+#include "../HsVersions.h"
 #include "../includes/MachDeps.h"
 
 import CmmType
@@ -48,6 +58,7 @@ import Constants
 import Outputable
 import FastString
 
+import Data.Char( ord )
 import Data.Word
 \end{code}
 
@@ -234,36 +245,102 @@ retAddrSizeW = 1	-- One word
 %************************************************************************
 
 \begin{code}
+-- | A description of the layout of a closure.  Corresponds directly
+-- to the closure types in includes/rts/storage/ClosureTypes.h.
 data SMRep
-     -- static closure have an extra static link field at the end.
-  = GenericRep		-- GC routines consult sizes in info tbl
-	Bool		-- True <=> This is a static closure.  Affects how 
-			-- 	    we garbage-collect it
-	!Int		--  # ptr words
-	!Int		--  # non-ptr words
-	ClosureType	-- closure type
-
-  | BlackHoleRep
-
-data ClosureType	-- Corresponds 1-1 with the varieties of closures
-			-- implemented by the RTS.  Compare with includes/rts/storage/ClosureTypes.h
-    = Constr
-    | ConstrNoCaf
-    | Fun
-    | Thunk
-    | ThunkSelector
-\end{code}
+  = HeapRep              -- GC routines consult sizes in info tbl
+        IsStatic
+        !WordOff         --  # ptr words
+        !WordOff         --  # non-ptr words INCLUDING SLOP (see mkHeapRep below)
+        ClosureTypeInfo  -- type-specific info
+
+  | StackRep            -- Stack frame (RET_SMALL or RET_BIG)
+        Liveness
+
+-- | True <=> This is a static closure.  Affects how we garbage-collect it.
+-- Static closure have an extra static link field at the end.
+type IsStatic = Bool
+
+-- From an SMRep you can get to the closure type defined in
+-- includes/rts/storage/ClosureTypes.h. Described by the function
+-- rtsClosureType below.
+
+data ClosureTypeInfo
+  = Constr        ConstrTag ConstrDescription
+  | Fun           FunArity ArgDescr
+  | Thunk
+  | ThunkSelector SelectorOffset
+  | BlackHole
+
+type ConstrTag         = StgHalfWord
+type ConstrDescription = [Word8] -- result of dataConIdentity
+type FunArity          = StgHalfWord
+type SelectorOffset    = StgWord
+
+-------------------------
+-- We represent liveness bitmaps as a Bitmap (whose internal
+-- representation really is a bitmap).  These are pinned onto case return
+-- vectors to indicate the state of the stack for the garbage collector.
+-- 
+-- In the compiled program, liveness bitmaps that fit inside a single
+-- word (StgWord) are stored as a single word, while larger bitmaps are
+-- stored as a pointer to an array of words. 
+
+type Liveness = [Bool]   -- One Bool per word; True  <=> non-ptr or dead
+                         --                    False <=> ptr
+
+-------------------------
+-- An ArgDescr describes the argument pattern of a function
+
+data ArgDescr
+  = ArgSpec		-- Fits one of the standard patterns
+	!StgHalfWord	-- RTS type identifier ARG_P, ARG_N, ...
+
+  | ArgGen	 	-- General case
+	Liveness	-- Details about the arguments
+
+
+-----------------------------------------------------------------------------
+-- Construction
+
+mkHeapRep :: IsStatic -> WordOff -> WordOff -> ClosureTypeInfo -> SMRep
+mkHeapRep is_static ptr_wds nonptr_wds cl_type_info
+  = HeapRep is_static
+            ptr_wds
+            (nonptr_wds + slop_wds)
+            cl_type_info
+  where
+     slop_wds
+      | is_static = 0
+      | otherwise = max 0 (minClosureSize - (hdr_size + payload_size))
 
-Size of a closure header.
+     hdr_size     = closureTypeHdrSize cl_type_info
+     payload_size = ptr_wds + nonptr_wds
 
-\begin{code}
+
+mkStackRep :: [Bool] -> SMRep
+mkStackRep = StackRep
+
+blackHoleRep :: SMRep
+blackHoleRep = HeapRep False 0 0 BlackHole
+
+-----------------------------------------------------------------------------
+-- Size-related things
+
+-- | Size of a closure header (StgHeader in includes/rts/storage/Closures.h)
 fixedHdrSize :: WordOff
 fixedHdrSize = sTD_HDR_SIZE + profHdrSize
 
+-- | Size of the profiling part of a closure header
+-- (StgProfHeader in includes/rts/storage/Closures.h)
 profHdrSize  :: WordOff
 profHdrSize  | opt_SccProfilingOn   = pROF_HDR_SIZE
 	     | otherwise	    = 0
 
+-- | The garbage collector requires that every closure is at least as big as this.
+minClosureSize :: WordOff
+minClosureSize = fixedHdrSize + mIN_PAYLOAD_SIZE
+
 arrWordsHdrSize   :: ByteOff
 arrWordsHdrSize   = fixedHdrSize*wORD_SIZE + sIZEOF_StgArrWords_NoHdr
 
@@ -275,61 +352,150 @@ arrPtrsHdrSize    = fixedHdrSize*wORD_SIZE + sIZEOF_StgMutArrPtrs_NoHdr
 thunkHdrSize :: WordOff
 thunkHdrSize = fixedHdrSize + smp_hdr
 	where smp_hdr = sIZEOF_StgSMPThunkHeader `quot` wORD_SIZE
-\end{code}
 
-\begin{code}
-isStaticRep :: SMRep -> Bool
-isStaticRep (GenericRep is_static _ _ _) = is_static
-isStaticRep BlackHoleRep	         = False
-\end{code}
 
-\begin{code}
-#include "../includes/rts/storage/ClosureTypes.h"
--- Defines CONSTR, CONSTR_1_0 etc
+isStaticRep :: SMRep -> IsStatic
+isStaticRep (HeapRep is_static _ _ _) = is_static
+isStaticRep (StackRep {})	         = False
 
--- krc: only called by tickyDynAlloc in CgTicky; return
--- Nothing for a black hole so we can at least make something work.
-smRepClosureType :: SMRep -> Maybe ClosureType
-smRepClosureType (GenericRep _ _ _ ty) = Just ty
-smRepClosureType BlackHoleRep	       = Nothing
+nonHdrSize :: SMRep -> WordOff
+nonHdrSize (HeapRep _ p np _) = p + np
+nonHdrSize (StackRep bs)      = length bs
 
-smRepClosureTypeInt :: SMRep -> StgHalfWord
-smRepClosureTypeInt (GenericRep False 1 0 Constr) = CONSTR_1_0
-smRepClosureTypeInt (GenericRep False 0 1 Constr) = CONSTR_0_1
-smRepClosureTypeInt (GenericRep False 2 0 Constr) = CONSTR_2_0
-smRepClosureTypeInt (GenericRep False 1 1 Constr) = CONSTR_1_1
-smRepClosureTypeInt (GenericRep False 0 2 Constr) = CONSTR_0_2
-smRepClosureTypeInt (GenericRep False _ _ Constr) = CONSTR
+heapClosureSize :: SMRep -> WordOff
+heapClosureSize (HeapRep _ p np ty) = closureTypeHdrSize ty + p + np
+heapClosureSize _ = panic "SMRep.heapClosureSize"
 
-smRepClosureTypeInt (GenericRep False 1 0 Fun) = FUN_1_0
-smRepClosureTypeInt (GenericRep False 0 1 Fun) = FUN_0_1
-smRepClosureTypeInt (GenericRep False 2 0 Fun) = FUN_2_0
-smRepClosureTypeInt (GenericRep False 1 1 Fun) = FUN_1_1
-smRepClosureTypeInt (GenericRep False 0 2 Fun) = FUN_0_2
-smRepClosureTypeInt (GenericRep False _ _ Fun) = FUN
+closureTypeHdrSize :: ClosureTypeInfo -> WordOff
+closureTypeHdrSize ty = case ty of
+                  Thunk{}         -> thunkHdrSize
+                  ThunkSelector{} -> thunkHdrSize
+                  BlackHole{}     -> thunkHdrSize
+                  _               -> fixedHdrSize
+	-- All thunks use thunkHdrSize, even if they are non-updatable.
+	-- this is because we don't have separate closure types for
+	-- updatable vs. non-updatable thunks, so the GC can't tell the
+	-- difference.  If we ever have significant numbers of non-
+	-- updatable thunks, it might be worth fixing this.
 
-smRepClosureTypeInt (GenericRep False 1 0 Thunk) = THUNK_1_0
-smRepClosureTypeInt (GenericRep False 0 1 Thunk) = THUNK_0_1
-smRepClosureTypeInt (GenericRep False 2 0 Thunk) = THUNK_2_0
-smRepClosureTypeInt (GenericRep False 1 1 Thunk) = THUNK_1_1
-smRepClosureTypeInt (GenericRep False 0 2 Thunk) = THUNK_0_2
-smRepClosureTypeInt (GenericRep False _ _ Thunk) = THUNK
+-----------------------------------------------------------------------------
+-- deriving the RTS closure type from an SMRep
 
-smRepClosureTypeInt (GenericRep False _ _ ThunkSelector) =  THUNK_SELECTOR
+#include "../includes/rts/storage/ClosureTypes.h"
+#include "../includes/rts/storage/FunTypes.h"
+-- Defines CONSTR, CONSTR_1_0 etc
 
-smRepClosureTypeInt (GenericRep True _ _ Constr)      = CONSTR_STATIC
-smRepClosureTypeInt (GenericRep True _ _ ConstrNoCaf) = CONSTR_NOCAF_STATIC
-smRepClosureTypeInt (GenericRep True _ _ Fun)         = FUN_STATIC
-smRepClosureTypeInt (GenericRep True _ _ Thunk)       = THUNK_STATIC
+-- | Derives the RTS closure type from an 'SMRep'
+rtsClosureType :: SMRep -> StgHalfWord
+rtsClosureType (HeapRep False 1 0 Constr{}) = CONSTR_1_0
+rtsClosureType (HeapRep False 0 1 Constr{}) = CONSTR_0_1
+rtsClosureType (HeapRep False 2 0 Constr{}) = CONSTR_2_0
+rtsClosureType (HeapRep False 1 1 Constr{}) = CONSTR_1_1
+rtsClosureType (HeapRep False 0 2 Constr{}) = CONSTR_0_2
+rtsClosureType (HeapRep False _ _ Constr{}) = CONSTR
+
+rtsClosureType (HeapRep False 1 0 Fun{}) = FUN_1_0
+rtsClosureType (HeapRep False 0 1 Fun{}) = FUN_0_1
+rtsClosureType (HeapRep False 2 0 Fun{}) = FUN_2_0
+rtsClosureType (HeapRep False 1 1 Fun{}) = FUN_1_1
+rtsClosureType (HeapRep False 0 2 Fun{}) = FUN_0_2
+rtsClosureType (HeapRep False _ _ Fun{}) = FUN
+
+rtsClosureType (HeapRep False 1 0 Thunk{}) = THUNK_1_0
+rtsClosureType (HeapRep False 0 1 Thunk{}) = THUNK_0_1
+rtsClosureType (HeapRep False 2 0 Thunk{}) = THUNK_2_0
+rtsClosureType (HeapRep False 1 1 Thunk{}) = THUNK_1_1
+rtsClosureType (HeapRep False 0 2 Thunk{}) = THUNK_0_2
+rtsClosureType (HeapRep False _ _ Thunk{}) = THUNK
+
+rtsClosureType (HeapRep False _ _ ThunkSelector{}) =  THUNK_SELECTOR
+
+-- Approximation: we use the CONSTR_NOCAF_STATIC type for static constructors
+-- that have no pointer words only.
+rtsClosureType (HeapRep True 0 _ Constr{}) = CONSTR_NOCAF_STATIC  -- See isStaticNoCafCon below
+rtsClosureType (HeapRep True _ _ Constr{}) = CONSTR_STATIC
+rtsClosureType (HeapRep True _ _ Fun{})    = FUN_STATIC
+rtsClosureType (HeapRep True _ _ Thunk{})  = THUNK_STATIC
+
+rtsClosureType (HeapRep False _ _ BlackHole{}) =  BLACKHOLE
+
+rtsClosureType _ = panic "rtsClosureType"
+
+isStaticNoCafCon :: SMRep -> Bool
+-- This should line up exactly with CONSTR_NOCAF_STATIC above
+-- See Note [Static NoCaf constructors]
+isStaticNoCafCon (HeapRep True 0 _ Constr{}) = True
+isStaticNoCafCon _                           = False
 
-smRepClosureTypeInt BlackHoleRep = BLACKHOLE
+-- We export these ones
+rET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG :: StgHalfWord
+rET_SMALL   = RET_SMALL
+rET_BIG     = RET_BIG
+aRG_GEN     = ARG_GEN
+aRG_GEN_BIG = ARG_GEN_BIG
+\end{code}
 
-smRepClosureTypeInt _ = panic "smRepClosuretypeint"
+Note [Static NoCaf constructors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If we know that a top-level binding 'x' is not Caffy (ie no CAFs are 
+reachable from 'x'), then a statically allocated constructor (Just x)
+is also not Caffy, and the garbage collector need not follow its
+argument fields.  Exploiting this would require two static info tables
+for Just, for the two cases where the argument was Caffy or non-Caffy.
 
+Currently we don't do this; instead we treat nullary constructors 
+as non-Caffy, and the others as potentially Caffy.
 
--- We export these ones
-rET_SMALL, rET_BIG :: StgHalfWord
-rET_SMALL     = RET_SMALL
-rET_BIG       = RET_BIG
-\end{code}
 
+%************************************************************************
+%*									*
+             Pretty printing of SMRep and friends
+%*									*
+%************************************************************************
+
+\begin{code}
+instance Outputable ClosureTypeInfo where
+   ppr = pprTypeInfo
+
+instance Outputable SMRep where
+   ppr (HeapRep static ps nps tyinfo)
+     = hang (header <+> lbrace) 2 (ppr tyinfo <+> rbrace)
+     where
+       header = ptext (sLit "HeapRep")
+                <+> if static then ptext (sLit "static") else empty
+                <+> pp_n "ptrs" ps <+> pp_n "nonptrs" nps
+       pp_n :: String -> Int -> SDoc
+       pp_n _ 0 = empty
+       pp_n s n = int n <+> text s
+
+   ppr (StackRep bs) = ptext (sLit "StackRep") <+> ppr bs
+
+instance Outputable ArgDescr where
+  ppr (ArgSpec n) = ptext (sLit "ArgSpec") <+> integer (toInteger n)
+  ppr (ArgGen ls) = ptext (sLit "ArgGen") <+> ppr ls
+  
+pprTypeInfo :: ClosureTypeInfo -> SDoc
+pprTypeInfo (Constr tag descr)
+  = ptext (sLit "Con") <+> 
+    braces (sep [ ptext (sLit "tag:") <+> integer (toInteger tag)
+                , ptext (sLit "descr:") <> text (show descr) ])
+
+pprTypeInfo (Fun arity args)
+  = ptext (sLit "Fun") <+> 
+    braces (sep [ ptext (sLit "arity:") <+> integer (toInteger arity)
+                , ptext (sLit ("fun_type:")) <+> ppr args ])
+
+pprTypeInfo (ThunkSelector offset) 
+  = ptext (sLit "ThunkSel") <+> integer (toInteger offset)
+
+pprTypeInfo Thunk     = ptext (sLit "Thunk")
+pprTypeInfo BlackHole = ptext (sLit "BlackHole")
+
+
+stringToWord8s :: String -> [Word8]
+stringToWord8s s = map (fromIntegral . ord) s
+
+pprWord8String :: [Word8] -> SDoc
+-- Debug printing.  Not very clever right now.
+pprWord8String ws = text (show ws)
+\end{code}
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs
index 29a254fafc..6f404f04a0 100644
--- a/compiler/codeGen/StgCmm.hs
+++ b/compiler/codeGen/StgCmm.hs
@@ -17,15 +17,12 @@ import StgCmmEnv
 import StgCmmBind
 import StgCmmCon
 import StgCmmLayout
-import StgCmmHeap
 import StgCmmUtils
 import StgCmmClosure
 import StgCmmHpc
 import StgCmmTicky
 
-import MkGraph
-import CmmExpr
-import CmmDecl
+import Cmm
 import CLabel
 import PprCmm
 
@@ -50,7 +47,7 @@ codeGen :: DynFlags
          -> CollectedCCs                -- (Local/global) cost-centres needing declaring/registering.
 	 -> [(StgBinding,[(Id,[Id])])]	-- Bindings to convert, with SRTs
 	 -> HpcInfo
-	 -> IO [Cmm]		-- Output
+         -> IO [CmmPgm]         -- Output
 
 codeGen dflags this_mod data_tycons
         cost_centre_info stg_binds hpc_info
@@ -64,7 +61,7 @@ codeGen dflags this_mod data_tycons
                 ; cmm_tycons <- mapM cgTyCon data_tycons
                 ; cmm_init   <- getCmm (mkModuleInit cost_centre_info
                                              this_mod hpc_info)
-                ; return (cmm_init : cmm_binds ++ concat cmm_tycons)
+                ; return (cmm_init : cmm_binds ++ cmm_tycons)
                 }
                 -- Put datatype_stuff after code_stuff, because the
                 -- datatype closure table (for enumeration types) to
@@ -182,7 +179,7 @@ mkModuleInit cost_centre_info this_mod hpc_info
         ; initCostCentres cost_centre_info
             -- For backwards compatibility: user code may refer to this
             -- label for calling hs_add_root().
-        ; emitData Data $ Statics (mkPlainModuleInitLabel this_mod) []
+        ; emitDecl (CmmData Data (Statics (mkPlainModuleInitLabel this_mod) []))
         }
 
 ---------------------------------------------------------------
@@ -216,7 +213,7 @@ For charlike and intlike closures there is a fixed array of static
 closures predeclared.
 -}
 
-cgTyCon :: TyCon -> FCode [Cmm]  -- All constructors merged together
+cgTyCon :: TyCon -> FCode CmmPgm  -- All constructors merged together
 cgTyCon tycon
   = do	{ constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
 
@@ -230,10 +227,10 @@ cgTyCon tycon
             -- code puts it before --- NR 16 Aug 2007
 	; extra <- cgEnumerationTyCon tycon
 
-        ; return (extra ++ constrs)
+        ; return (concat (extra ++ constrs))
         }
 
-cgEnumerationTyCon :: TyCon -> FCode [Cmm]
+cgEnumerationTyCon :: TyCon -> FCode [CmmPgm]
 cgEnumerationTyCon tycon
   | isEnumerationTyCon tycon
   = do	{ tbl <- getCmm $ 
@@ -254,8 +251,13 @@ cgDataCon data_con
 	    -- static data structures (ie those built at compile
 	    -- time), we take care that info-table contains the
 	    -- information we need.
-	    (static_cl_info, _) = layOutStaticConstr data_con arg_reps
-	    (dyn_cl_info, arg_things) = layOutDynConstr data_con arg_reps
+	    static_cl_info = mkConInfo True  no_cafs   data_con tot_wds ptr_wds
+	    dyn_cl_info    = mkConInfo False NoCafRefs data_con tot_wds ptr_wds
+            no_cafs = pprPanic "cgDataCon: CAF field should not be reqd" (ppr data_con)
+
+    	    (tot_wds, --  #ptr_wds + #nonptr_wds
+    	     ptr_wds, --  #ptr_wds
+    	     arg_things) = mkVirtConstrOffsets arg_reps
 
 	    emit_info cl_info ticky_code
 		= emitClosureAndInfoTable cl_info NativeDirectCall []
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index 2947d33042..ef432ae6d2 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -31,8 +31,7 @@ import StgCmmForeign    (emitPrimCall)
 import MkGraph
 import CoreSyn		( AltCon(..) )
 import SMRep
-import CmmDecl
-import CmmExpr
+import Cmm
 import CmmUtils
 import CLabel
 import StgSyn
@@ -75,7 +74,8 @@ cgTopRhsClosure id ccs _ upd_flag srt args body = do
 	closure_info  = mkClosureInfo True id lf_info 0 0 srt_info descr
 	closure_label = mkLocalClosureLabel name (idCafInfo id)
     	cg_id_info    = litIdInfo id lf_info (CmmLabel closure_label)
-	closure_rep   = mkStaticClosureFields closure_info ccs True []
+        caffy         = idCafInfo id
+	closure_rep   = mkStaticClosureFields closure_info ccs caffy []
 
   	 -- BUILD THE OBJECT, AND GENERATE INFO TABLE (IF NECESSARY)
   ; emitDataLits closure_label closure_rep
@@ -209,7 +209,7 @@ mkRhsClosure	bndr cc bi
 		body@(StgCase (StgApp scrutinee [{-no args-}])
 		      _ _ _ _   -- ignore uniq, etc.
 		      (AlgAlt _)
-		      [(DataAlt con, params, _use_mask,
+		      [(DataAlt _, params, _use_mask,
 			    (StgApp selectee [{-no args-}]))])
   |  the_fv == scrutinee		-- Scrutinee is the only free variable
   && maybeToBool maybe_offset		-- Selectee is a component of the tuple
@@ -226,8 +226,8 @@ mkRhsClosure	bndr cc bi
   where
     lf_info 		  = mkSelectorLFInfo bndr offset_into_int
 				 (isUpdatable upd_flag)
-    (_, params_w_offsets) = layOutDynConstr con (addIdReps params)
-			-- Just want the layout
+    (_, _, params_w_offsets) = mkVirtConstrOffsets (addIdReps params)
+			       -- Just want the layout
     maybe_offset	  = assocMaybe params_w_offsets (NonVoid selectee)
     Just the_offset 	  = maybe_offset
     offset_into_int       = the_offset - fixedHdrSize
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index daaf021f03..88d1498728 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -16,29 +16,28 @@ module StgCmmClosure (
 	DynTag,  tagForCon, isSmallFamily,
 	ConTagZ, dataConTagZ,
 
-	ArgDescr(..), Liveness(..), 
+	ArgDescr(..), Liveness, 
 	C_SRT(..), needsSRT,
 
 	isVoidRep, isGcPtrRep, addIdReps, addArgReps,
 	argPrimRep, 
 
+	-----------------------------------
 	LambdaFormInfo,		-- Abstract
 	StandardFormInfo,	-- ...ditto...
 	mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
 	mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
 	lfDynTag,
+        maybeIsLFCon, isLFThunk, isLFReEntrant,
 
+	-----------------------------------
 	ClosureInfo,
-	mkClosureInfo, mkConInfo, maybeIsLFCon,
+	mkClosureInfo, mkConInfo, 
 
-	closureSize, closureNonHdrSize,
-	closureGoodStuffSize, closurePtrsSize,
-	slopSize, 
-
-	closureName, infoTableLabelFromCI, entryLabelFromCI,
-	closureLabelFromCI,
-	closureTypeInfo,
-	closureLFInfo, isLFThunk,closureSMRep, closureUpdReqd, 
+        closureSize,
+        closureName, infoTableLabelFromCI, entryLabelFromCI,
+	closureLabelFromCI, closureProf, closureSRT,
+	closureLFInfo, closureSMRep, closureUpdReqd, 
 	closureNeedsUpdSpace, closureIsThunk,
 	closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
 	closureFunInfo,	isStandardFormThunk, isKnownFun,
@@ -51,11 +50,7 @@ module StgCmmClosure (
 
 	blackHoleOnEntry,
 
-	getClosureType,
-
 	isToplevClosure,
-	closureValDescr, closureTypeDescr,	-- profiling
-
 	isStaticClosure,
 	cafBlackHoleClosureInfo, 
 
@@ -67,13 +62,9 @@ module StgCmmClosure (
 #define FAST_STRING_NOT_NEEDED
 #include "HsVersions.h"
 
-import ClosureInfo (ArgDescr(..), C_SRT(..), Liveness(..))
-	-- XXX temporary becuase FunInfo needs this one
-
 import StgSyn
 import SMRep
-import CmmDecl ( ClosureTypeInfo(..), ConstrDescription )
-import CmmExpr
+import Cmm
 
 import CLabel
 import StaticFlags
@@ -352,13 +343,16 @@ maybeIsLFCon _ = Nothing
 
 ------------
 isLFThunk :: LambdaFormInfo -> Bool
-isLFThunk (LFThunk _ _ _ _ _)  = True
-isLFThunk LFBlackHole          = True
+isLFThunk (LFThunk {})  = True
+isLFThunk LFBlackHole   = True
 	-- return True for a blackhole: this function is used to determine
 	-- whether to use the thunk header in SMP mode, and a blackhole
 	-- must have one.
 isLFThunk _ = False
 
+isLFReEntrant :: LambdaFormInfo -> Bool
+isLFReEntrant (LFReEntrant {}) = True
+isLFReEntrant _                = False
 
 -----------------------------------------------------------------------------
 --		Choosing SM reps
@@ -371,28 +365,26 @@ chooseSMRep
 	-> SMRep
 
 chooseSMRep is_static lf_info tot_wds ptr_wds
-  = let
-	 nonptr_wds   = tot_wds - ptr_wds
-	 closure_type = getClosureType is_static ptr_wds lf_info
-    in
-    GenericRep is_static ptr_wds nonptr_wds closure_type	
+  = mkHeapRep is_static ptr_wds nonptr_wds (lfClosureType lf_info)
+  where
+    nonptr_wds = tot_wds - ptr_wds
+
+lfClosureType :: LambdaFormInfo -> ClosureTypeInfo
+lfClosureType (LFReEntrant _ arity _ argd) = Fun (fromIntegral arity) argd
+lfClosureType (LFCon con)                  =  Constr (fromIntegral (dataConTagZ con))
+                			              (dataConIdentity con)
+lfClosureType (LFThunk _ _ _ is_sel _) 	   = thunkClosureType is_sel
+lfClosureType _                 	   = panic "lfClosureType"
+
+thunkClosureType :: StandardFormInfo -> ClosureTypeInfo
+thunkClosureType (SelectorThunk off) = ThunkSelector (fromIntegral off)
+thunkClosureType _                   = Thunk
 
 -- We *do* get non-updatable top-level thunks sometimes.  eg. f = g
 -- gets compiled to a jump to g (if g has non-zero arity), instead of
 -- messing around with update frames and PAPs.  We set the closure type
 -- to FUN_STATIC in this case.
 
-getClosureType :: Bool -> WordOff -> LambdaFormInfo -> ClosureType
-getClosureType is_static ptr_wds lf_info
-  = case lf_info of
-	LFCon {} | is_static && ptr_wds == 0 -> ConstrNoCaf
-		 | otherwise		     -> Constr
-  	LFReEntrant {}			     -> Fun
-	LFThunk _ _ _ (SelectorThunk {}) _   -> ThunkSelector
-	LFThunk {} 			     -> Thunk
-	_ -> panic "getClosureType"
-
-
 -----------------------------------------------------------------------------
 --		nodeMustPointToIt
 -----------------------------------------------------------------------------
@@ -668,6 +660,15 @@ We make a ClosureInfo for
   - each let binding (both top level and not)
   - each data constructor (for its shared static and
 	dynamic info tables)
+
+Note [Closure CAF info]
+~~~~~~~~~~~~~~~~~~~~~~~
+The closureCafs field is relevant for *static closures only*.  It records
+  * For an ordinary closure, whether a CAF is reachable from
+    the code for the closure
+  * For a constructor closure, whether a CAF is reachable
+    from the fields of the constructor
+It is initialised simply from the idCafInfo of the Id. 
 -}
 
 data ClosureInfo
@@ -676,36 +677,22 @@ data ClosureInfo
 	closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below)
 	closureSMRep  :: !SMRep,	  -- representation used by storage mgr
 	closureSRT    :: !C_SRT,	  -- What SRT applies to this closure
-	closureType   :: !Type,		  -- Type of closure (ToDo: remove)
-	closureDescr  :: !String,	  -- closure description (for profiling)
-        closureCafs   :: !CafInfo,        -- whether the closure may have CAFs
-	closureInfLcl :: Bool             -- can the info pointer be a local symbol?
+	closureProf   :: !ProfilingInfo,
+        closureCafs   :: !CafInfo,        -- See Note [Closure CAF info]
+	closureInfLcl :: Bool             -- Can the info pointer be a local symbol?
     }
 
   -- Constructor closures don't have a unique info table label (they use
   -- the constructor's info table), and they don't have an SRT.
   | ConInfo {
-	closureCon       :: !DataCon,
-	closureSMRep     :: !SMRep
+	closureCon   :: !DataCon,
+	closureSMRep :: !SMRep,
+        closureCafs  :: !CafInfo        -- See Note [Closure CAF info]
     }
 
-{- 	XXX temp imported from old ClosureInfo 
--- C_SRT is what StgSyn.SRT gets translated to... 
--- we add a label for the table, and expect only the 'offset/length' form
-
-data C_SRT = NoC_SRT
-	   | C_SRT !CLabel !WordOff !StgHalfWord {-bitmap or escape-}
-           deriving (Eq)
-
-instance Outputable C_SRT where
-  ppr (NoC_SRT) = ptext SLIT("_no_srt_")
-  ppr (C_SRT label off bitmap) = parens (ppr label <> comma <> ppr off <> comma <> text (show bitmap))
--}
-
-needsSRT :: C_SRT -> Bool
-needsSRT NoC_SRT       = False
-needsSRT (C_SRT _ _ _) = True
-
+clHasCafRefs :: ClosureInfo -> CafInfo
+-- Backward compatibility; remove
+clHasCafRefs = closureCafs
 
 --------------------------------------
 --	Building ClosureInfos
@@ -718,13 +705,12 @@ mkClosureInfo :: Bool		-- Is static
 	      -> C_SRT
 	      -> String		-- String descriptor
 	      -> ClosureInfo
-mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr
+mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info val_descr
   = ClosureInfo { closureName = name, 
 		  closureLFInfo = lf_info,
 		  closureSMRep = sm_rep, 
 		  closureSRT = srt_info,
-		  closureType = idType id,
-		  closureDescr = descr,
+		  closureProf = prof,
                   closureCafs = idCafInfo id,
 		  closureInfLcl = isDataConWorkId id }
 		    -- Make the _info pointer for the implicit datacon worker binding
@@ -733,18 +719,23 @@ mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr
 		    -- anything else gets eta expanded.
   where
     name   = idName id
-    sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
+    sm_rep = mkHeapRep is_static ptr_wds nonptr_wds (lfClosureType lf_info)
+    prof   = mkProfilingInfo id val_descr
+    nonptr_wds = tot_wds - ptr_wds
 
 mkConInfo :: Bool	-- Is static
+	  -> CafInfo 
 	  -> DataCon	
 	  -> Int -> Int	-- Total and pointer words
 	  -> ClosureInfo
-mkConInfo is_static data_con tot_wds ptr_wds
-   = ConInfo {	closureSMRep = sm_rep,
-		closureCon = data_con }
+mkConInfo is_static cafs data_con tot_wds ptr_wds
+   = ConInfo { closureSMRep = sm_rep
+             , closureCafs = cafs
+	     , closureCon = data_con }
   where
-    sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
-
+    sm_rep  = mkHeapRep is_static ptr_wds nonptr_wds (lfClosureType lf_info)
+    lf_info = mkConLFInfo data_con
+    nonptr_wds = tot_wds - ptr_wds
 
 -- We need a black-hole closure info to pass to @allocDynClosure@ when we
 -- want to allocate the black hole on entry to a CAF.  These are the only
@@ -752,119 +743,20 @@ mkConInfo is_static data_con tot_wds ptr_wds
 -- is a black hole and not something else.
 
 cafBlackHoleClosureInfo :: ClosureInfo -> ClosureInfo
-cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
-				       closureType = ty,
-				       closureCafs = cafs })
-  = ClosureInfo { closureName   = nm,
-		  closureLFInfo = LFBlackHole,
-		  closureSMRep  = BlackHoleRep,
-		  closureSRT    = NoC_SRT,
-		  closureType   = ty,
-		  closureDescr  = "", 
-		  closureCafs   = cafs,
-		  closureInfLcl = False }
-cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
-
+cafBlackHoleClosureInfo cl_info@(ClosureInfo {})
+  = cl_info { closureLFInfo = LFBlackHole
+	    , closureSMRep  = blackHoleRep
+	    , closureSRT    = NoC_SRT
+	    , closureInfLcl = False }
+cafBlackHoleClosureInfo (ConInfo {}) = panic "cafBlackHoleClosureInfo"
 
---------------------------------------
---   Extracting ClosureTypeInfo
---------------------------------------
-
--- JD: I've added the continuation arguments not for fun but because
--- I don't want to pipe the monad in here (circular module dependencies),
--- and I don't want to pull this code out of this module, which would
--- require us to expose a bunch of abstract types.
-
-closureTypeInfo ::
-  ClosureInfo -> ((ConstrDescription -> ClosureTypeInfo) -> DataCon -> CLabel -> a) ->
-  (ClosureTypeInfo -> a) -> a
-closureTypeInfo cl_info k_with_con_name k_simple
-   = case cl_info of
-	ConInfo { closureCon = con } 
-		-> k_with_con_name (ConstrInfo (ptrs, nptrs)
-			              (fromIntegral (dataConTagZ con))) con info_lbl
-		where
-		  --con_name = panic "closureTypeInfo"
-			-- Was: 
-			-- cstr <- mkByteStringCLit $ dataConIdentity con
-			-- con_name = makeRelativeRefTo info_lbl cstr
-
-    	ClosureInfo { closureName   = name,
-                      closureLFInfo = LFReEntrant _ arity _ arg_descr,
-                      closureSRT    = srt }
-		-> k_simple $ FunInfo (ptrs, nptrs)
-	                        srt 
-	                        (fromIntegral arity)
-	                        arg_descr 
-	                        (CmmLabel (mkSlowEntryLabel name (clHasCafRefs cl_info)))
-  
-  	ClosureInfo { closureLFInfo = LFThunk _ _ _ (SelectorThunk offset) _, 
-                      closureSRT    = srt }
- 		-> k_simple $ ThunkSelectorInfo (fromIntegral offset) srt
-
-    	ClosureInfo { closureLFInfo = LFThunk {}, 
-                      closureSRT    = srt }
-		-> k_simple $ ThunkInfo (ptrs, nptrs) srt
-
-        _ -> panic "unexpected lambda form in mkCmmInfo"
-  where
-    info_lbl = infoTableLabelFromCI cl_info
-    ptrs     = fromIntegral $ closurePtrsSize cl_info
-    size     = fromIntegral $ closureNonHdrSize cl_info
-    nptrs    = size - ptrs
 
 --------------------------------------
 --   Functions about closure *sizes*
 --------------------------------------
 
 closureSize :: ClosureInfo -> WordOff
-closureSize cl_info = hdr_size + closureNonHdrSize cl_info
-  where hdr_size  | closureIsThunk cl_info = thunkHdrSize
-  		  | otherwise      	   = fixedHdrSize
-	-- All thunks use thunkHdrSize, even if they are non-updatable.
-	-- this is because we don't have separate closure types for
-	-- updatable vs. non-updatable thunks, so the GC can't tell the
-	-- difference.  If we ever have significant numbers of non-
-	-- updatable thunks, it might be worth fixing this.
-
-closureNonHdrSize :: ClosureInfo -> WordOff
-closureNonHdrSize cl_info
-  = tot_wds + computeSlopSize tot_wds cl_info
-  where
-    tot_wds = closureGoodStuffSize cl_info
-
-closureGoodStuffSize :: ClosureInfo -> WordOff
-closureGoodStuffSize cl_info
-  = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)
-    in	ptrs + nonptrs
-
-closurePtrsSize :: ClosureInfo -> WordOff
-closurePtrsSize cl_info
-  = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)
-    in	ptrs
-
--- not exported:
-sizes_from_SMRep :: SMRep -> (WordOff,WordOff)
-sizes_from_SMRep (GenericRep _ ptrs nonptrs _)   = (ptrs, nonptrs)
-sizes_from_SMRep BlackHoleRep			 = (0, 0)
-
--- Computing slop size.  WARNING: this looks dodgy --- it has deep
--- knowledge of what the storage manager does with the various
--- representations...
---
--- Slop Requirements: every thunk gets an extra padding word in the
--- header, which takes the the updated value.
-
-slopSize :: ClosureInfo -> WordOff
-slopSize cl_info = computeSlopSize payload_size cl_info
-  where payload_size = closureGoodStuffSize cl_info
-
-computeSlopSize :: WordOff -> ClosureInfo -> WordOff
-computeSlopSize payload_size cl_info
-  = max 0 (minPayloadSize smrep updatable - payload_size)
-  where
-	smrep        = closureSMRep cl_info
-	updatable    = closureNeedsUpdSpace cl_info
+closureSize cl_info = heapClosureSize (closureSMRep cl_info)
 
 closureNeedsUpdSpace :: ClosureInfo -> Bool
 -- We leave space for an update if either (a) the closure is updatable
@@ -875,21 +767,6 @@ closureNeedsUpdSpace (ClosureInfo { closureLFInfo =
 					LFThunk TopLevel _ _ _ _ }) = True
 closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
 
-minPayloadSize :: SMRep -> Bool -> WordOff
-minPayloadSize smrep updatable
-  = case smrep of
-	BlackHoleRep		 		-> min_upd_size
-	GenericRep _ _ _ _      | updatable     -> min_upd_size
-	GenericRep True _ _ _                   -> 0 -- static
-	GenericRep False _ _ _                  -> mIN_PAYLOAD_SIZE
-          --       ^^^^^___ dynamic
-  where
-   min_upd_size =
-	ASSERT(mIN_PAYLOAD_SIZE <= sIZEOF_StgSMPThunkHeader)
-	0 	-- check that we already have enough
-		-- room for mIN_SIZE_NonUpdHeapObject,
-		-- due to the extra header word in SMP
-
 --------------------------------------
 --   Other functions over ClosureInfo
 --------------------------------------
@@ -929,13 +806,8 @@ staticClosureNeedsLink :: ClosureInfo -> Bool
 -- of the SRT.
 staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
   = needsSRT srt
-staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
-  = not (isNullaryRepDataCon con) && not_nocaf_constr
-  where
-    not_nocaf_constr = 
-	case sm_rep of 
-	   GenericRep _ _ _ ConstrNoCaf -> False
-	   _other			-> True
+staticClosureNeedsLink (ConInfo { closureSMRep = rep })
+  = not (isStaticNoCafCon rep)
 
 isStaticClosure :: ClosureInfo -> Bool
 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
@@ -998,28 +870,32 @@ entryLabelFromCI :: ClosureInfo -> CLabel
 entryLabelFromCI = snd . labelsFromCI
 
 labelsFromCI :: ClosureInfo -> (CLabel, CLabel) -- (Info, Entry)
-labelsFromCI cl@(ClosureInfo { closureName = name,
-			       closureLFInfo = lf_info,
-			       closureInfLcl = is_lcl })
+labelsFromCI (ClosureInfo { closureName = name,
+			    closureLFInfo = lf_info,
+			    closureCafs = cafs,
+			    closureInfLcl = is_lcl })
   = case lf_info of
 	LFBlackHole -> (mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel)
 
-	LFThunk _ _ upd_flag (SelectorThunk offset) _ -> 
-		bothL (mkSelectorInfoLabel, mkSelectorEntryLabel) upd_flag offset
-
-	LFThunk _ _ upd_flag (ApThunk arity) _ -> 
-		bothL (mkApInfoTableLabel, mkApEntryLabel) upd_flag arity
+	LFThunk _ _ upd_flag (SelectorThunk offset) _ 
+		      -> bothL (mkSelectorInfoLabel, mkSelectorEntryLabel) upd_flag offset
 
-	LFThunk{}      -> bothL std_mk_lbls name $ clHasCafRefs cl
+	LFThunk _ _ upd_flag (ApThunk arity) _ 
+		      -> bothL (mkApInfoTableLabel, mkApEntryLabel) upd_flag arity
 
-	LFReEntrant _ _ _ _ -> bothL std_mk_lbls name $ clHasCafRefs cl
+	LFThunk{}     -> bothL std_mk_lbls name cafs
+	LFReEntrant{} -> bothL std_mk_lbls name cafs
+	_other        -> panic "labelsFromCI"
 
-	_other -> panic "labelsFromCI"
-  where std_mk_lbls = if is_lcl then (mkLocalInfoTableLabel, mkLocalEntryLabel) else (mkInfoTableLabel, mkEntryLabel)
+  where 
+    std_mk_lbls | is_lcl    = (mkLocalInfoTableLabel, mkLocalEntryLabel)
+                | otherwise = (mkInfoTableLabel, mkEntryLabel)
 
-labelsFromCI cl@(ConInfo { closureCon = con, closureSMRep = rep })
-  | isStaticRep rep = bothL (mkStaticInfoTableLabel, mkStaticConEntryLabel)  name $ clHasCafRefs cl
-  | otherwise	    = bothL (mkConInfoTableLabel,    mkConEntryLabel)     name $ clHasCafRefs cl
+labelsFromCI (ConInfo { closureCon = con, closureSMRep = rep, closureCafs = cafs })
+  | isStaticRep rep 
+  = bothL (mkStaticInfoTableLabel, mkStaticConEntryLabel) name cafs
+  | otherwise	    
+  = bothL (mkConInfoTableLabel,    mkConEntryLabel)       name cafs
   where
     name = dataConName con
 
@@ -1076,16 +952,13 @@ enterLocalIdLabel id c
 -- The type is determined from the type information stored with the @Id@
 -- in the closure info using @closureTypeDescr@.
 
-closureValDescr, closureTypeDescr :: ClosureInfo -> String
-closureValDescr (ClosureInfo {closureDescr = descr}) 
-  = descr
-closureValDescr (ConInfo {closureCon = con})
-  = occNameString (getOccName con)
-
-closureTypeDescr (ClosureInfo { closureType = ty })
-  = getTyDescription ty
-closureTypeDescr (ConInfo { closureCon = data_con })
-  = occNameString (getOccName (dataConTyCon data_con))
+mkProfilingInfo :: Id -> String -> ProfilingInfo
+mkProfilingInfo id val_descr
+  | not opt_SccProfilingOn = NoProfilingInfo
+  | otherwise = ProfilingInfo ty_descr_w8 val_descr_w8
+  where
+    ty_descr_w8  = stringToWord8s (getTyDescription (idType id))
+    val_descr_w8 = stringToWord8s val_descr
 
 getTyDescription :: Type -> String
 getTyDescription ty
@@ -1107,11 +980,3 @@ getPredTyDescription (ClassP cl _) = getOccString cl
 getPredTyDescription (IParam ip _) = getOccString (ipNameName ip)
 getPredTyDescription (EqPred {})   = "Type equality"
 
---------------------------------------
---   SRTs/CAFs
---------------------------------------
-
--- We need to know whether a closure may have CAFs.
-clHasCafRefs :: ClosureInfo -> CafInfo
-clHasCafRefs (ClosureInfo {closureCafs = cafs}) = cafs
-clHasCafRefs (ConInfo {}) = NoCafRefs
diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs
index 368bc53483..724490c133 100644
--- a/compiler/codeGen/StgCmmCon.hs
+++ b/compiler/codeGen/StgCmmCon.hs
@@ -34,6 +34,7 @@ import Module
 import Constants
 import DataCon
 import FastString
+import IdInfo( CafInfo(..) )
 import Id
 import Literal
 import PrelInfo
@@ -68,10 +69,13 @@ cgTopRhsCon id con args
 	; let
 	    name          = idName id
 	    lf_info	  = mkConLFInfo con
-    	    closure_label = mkClosureLabel name $ idCafInfo id
-	    caffy         = any stgArgHasCafRefs args
-	    (closure_info, nv_args_w_offsets) 
-			= layOutStaticConstr con (addArgReps args)
+    	    closure_label = mkClosureLabel name caffy
+	    caffy         = idCafInfo id -- any stgArgHasCafRefs args
+            
+    	    (tot_wds, --  #ptr_wds + #nonptr_wds
+    	     ptr_wds, --  #ptr_wds
+    	     nv_args_w_offsets) = mkVirtConstrOffsets (addArgReps args)
+	    closure_info = mkConInfo False caffy con tot_wds ptr_wds
 
 	    get_lit (arg, _offset) = do { CmmLit lit <- getArgAmode arg
 				        ; return lit }
@@ -190,8 +194,10 @@ buildDynCon binder _cc con [arg]
 
 -------- buildDynCon: the general case -----------
 buildDynCon binder ccs con args
-  = do	{ let (cl_info, args_w_offsets) = layOutDynConstr con (addArgReps args)
+  = do	{ let (tot_wds, ptr_wds, args_w_offsets) 
+                = mkVirtConstrOffsets (addArgReps args)
 		-- No void args in args_w_offsets
+              cl_info = mkConInfo False NoCafRefs con tot_wds ptr_wds
 	; (tmp, init) <- allocDynClosure cl_info use_cc blame_cc args_w_offsets
 	; regIdInfo binder lf_info tmp init }
   where
@@ -217,7 +223,7 @@ bindConArgs (DataAlt con) base args
   = ASSERT(not (isUnboxedTupleCon con))
     mapM bind_arg args_w_offsets
   where
-    (_, args_w_offsets) = layOutDynConstr con (addIdReps args)
+    (_, _, args_w_offsets) = mkVirtConstrOffsets (addIdReps args)
 
     tag = tagForCon con
 
diff --git a/compiler/codeGen/StgCmmEnv.hs b/compiler/codeGen/StgCmmEnv.hs
index 369e1993aa..25bbe8f63f 100644
--- a/compiler/codeGen/StgCmmEnv.hs
+++ b/compiler/codeGen/StgCmmEnv.hs
@@ -70,33 +70,39 @@ nonVoidIds ids = [NonVoid id | id <- ids, not (isVoidRep (idPrimRep id))]
 
 mkCgIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo
 mkCgIdInfo id lf expr
-  = CgIdInfo { cg_id = id, cg_loc = CmmLoc expr, 
-	       cg_lf = lf, cg_rep = idPrimRep id, 
+  = CgIdInfo { cg_id = id, cg_rep = idPrimRep id, cg_lf = lf 
+             , cg_loc = CmmLoc expr, 
 	       cg_tag = lfDynTag lf }
 
+litIdInfo :: Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
+litIdInfo id lf lit
+  = CgIdInfo { cg_id = id, cg_rep = idPrimRep id, cg_lf = lf
+             , cg_loc = CmmLoc (addDynTag (CmmLit lit) tag) 
+	     , cg_tag = tag }
+  where
+    tag = lfDynTag lf
+
 lneIdInfo :: Id -> [LocalReg] -> CgIdInfo
 lneIdInfo id regs 
-  = CgIdInfo { cg_id = id, cg_loc = LneLoc blk_id regs,
-	       cg_lf = lf, cg_rep = idPrimRep id, 
-	       cg_tag = lfDynTag lf }
+  = CgIdInfo { cg_id = id, cg_rep = idPrimRep id, cg_lf = lf 
+             , cg_loc = LneLoc blk_id regs
+	     , cg_tag = lfDynTag lf }
   where
     lf     = mkLFLetNoEscape
     blk_id = mkBlockId (idUnique id)
 
-litIdInfo :: Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
-litIdInfo id lf_info lit = --mkCgIdInfo id lf_info (CmmLit lit)
-  mkCgIdInfo id lf_info (addDynTag (CmmLit lit) (lfDynTag lf_info))
-
 -- Because the register may be spilled to the stack in untagged form, we
 -- modify the initialization code 'init' to immediately tag the
 -- register, and store a plain register in the CgIdInfo.  We allocate
 -- a new register in order to keep single-assignment and help out the
 -- inliner. -- EZY
 regIdInfo :: Id -> LambdaFormInfo -> LocalReg -> CmmAGraph -> FCode (CgIdInfo, CmmAGraph)
-regIdInfo id lf_info reg init = do
-  reg' <- newTemp (localRegType reg)
-  let init' = init <*> mkAssign (CmmLocal reg') (addDynTag (CmmReg (CmmLocal reg)) (lfDynTag lf_info))
-  return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg')), init')
+regIdInfo id lf_info reg init 
+  = do { reg' <- newTemp (localRegType reg)
+       ; let init' = init <*> mkAssign (CmmLocal reg') 
+                                       (addDynTag (CmmReg (CmmLocal reg)) 
+                                                  (lfDynTag lf_info))
+       ; return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg')), init') }
 
 idInfoToAmode :: CgIdInfo -> CmmExpr
 -- Returns a CmmExpr for the *tagged* pointer
diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index fa16b2a7f5..d9ae62e206 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -29,7 +29,7 @@ import StgSyn
 
 import MkGraph
 import BlockId
-import CmmExpr
+import Cmm
 import CoreSyn
 import DataCon
 import ForeignCall
diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs
index b9e9224fd5..54a0214bcb 100644
--- a/compiler/codeGen/StgCmmForeign.hs
+++ b/compiler/codeGen/StgCmmForeign.hs
@@ -24,8 +24,7 @@ import StgCmmUtils
 import StgCmmClosure
 
 import BlockId
-import CmmDecl
-import CmmExpr
+import Cmm
 import CmmUtils
 import OldCmm ( CmmReturnInfo(..) )
 import MkGraph
diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs
index 0015da1cac..050ea10083 100644
--- a/compiler/codeGen/StgCmmHeap.hs
+++ b/compiler/codeGen/StgCmmHeap.hs
@@ -12,8 +12,8 @@ module StgCmmHeap (
 
         entryHeapCheck, altHeapCheck,
 
-        layOutDynConstr, layOutStaticConstr,
-        mkVirtHeapOffsets, mkStaticClosureFields, mkStaticClosure,
+        mkVirtHeapOffsets, mkVirtConstrOffsets,
+        mkStaticClosureFields, mkStaticClosure,
 
         allocDynClosure, allocDynClosureCmm, emitSetDynHdr
     ) where
@@ -35,40 +35,16 @@ import StgCmmEnv
 import MkGraph
 
 import SMRep
-import CmmExpr
+import Cmm
 import CmmUtils
-import DataCon
-import TyCon
 import CostCentre
 import Outputable
+import IdInfo( CafInfo(..), mayHaveCafRefs )
 import Module
 import FastString( mkFastString, fsLit )
 import Constants
 
 -----------------------------------------------------------
---              Layout of heap objects
------------------------------------------------------------
-
-layOutDynConstr, layOutStaticConstr
-        :: DataCon -> [(PrimRep, a)]
-        -> (ClosureInfo, [(NonVoid a, VirtualHpOffset)])
-        -- No Void arguments in result
-
-layOutDynConstr    = layOutConstr False
-layOutStaticConstr = layOutConstr True
-
-layOutConstr :: Bool -> DataCon -> [(PrimRep, a)]
-             -> (ClosureInfo, [(NonVoid a, VirtualHpOffset)])
-layOutConstr is_static data_con args
-   = (mkConInfo is_static data_con tot_wds ptr_wds,
-      things_w_offsets)
-  where
-    (tot_wds, --  #ptr_wds + #nonptr_wds
-     ptr_wds, --  #ptr_wds
-     things_w_offsets) = mkVirtHeapOffsets False{-not a thunk-} args
-
-
------------------------------------------------------------
 --              Initialise dynamic heap objects
 -----------------------------------------------------------
 
@@ -175,7 +151,7 @@ hpStore base vals offs
 mkStaticClosureFields
         :: ClosureInfo
         -> CostCentreStack
-        -> Bool                 -- Has CAF refs
+        -> CafInfo
         -> [CmmLit]             -- Payload
         -> [CmmLit]             -- The full closure
 mkStaticClosureFields cl_info ccs caf_refs payload
@@ -210,12 +186,12 @@ mkStaticClosureFields cl_info ccs caf_refs payload
         | is_caf     = [mkIntCLit 0]
         | otherwise  = []
 
-        -- for a static constructor which has NoCafRefs, we set the
+        -- For a static constructor which has NoCafRefs, we set the
         -- static link field to a non-zero value so the garbage
         -- collector will ignore it.
     static_link_value
-        | caf_refs      = mkIntCLit 0
-        | otherwise     = mkIntCLit 1
+        | mayHaveCafRefs caf_refs  = mkIntCLit 0
+        | otherwise                = mkIntCLit 1  -- No CAF refs
 
 
 mkStaticClosure :: CLabel -> CostCentreStack -> [CmmLit]
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index 63fc840845..e9f7394b8b 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -15,7 +15,7 @@ module StgCmmLayout (
 
 	slowCall, directCall, 
 
-	mkVirtHeapOffsets, getHpRelOffset, hpRel,
+	mkVirtHeapOffsets, mkVirtConstrOffsets, getHpRelOffset, hpRel,
 
 	stdInfoTableSizeB,
 	entryCode, closureInfoPtr,
@@ -23,7 +23,7 @@ module StgCmmLayout (
         cmmGetClosureType,
 	infoTable, infoTableClosureType,
 	infoTablePtrs, infoTableNonPtrs,
-	funInfoTable, makeRelativeRefTo
+	funInfoTable
   ) where
 
 
@@ -32,27 +32,21 @@ module StgCmmLayout (
 import StgCmmClosure
 import StgCmmEnv
 import StgCmmTicky
-import StgCmmUtils
 import StgCmmMonad
+import StgCmmUtils
 
 import MkGraph
 import SMRep
-import CmmDecl
-import CmmExpr
+import Cmm
 import CmmUtils
 import CLabel
 import StgSyn
-import DataCon
 import Id
 import Name
 import TyCon		( PrimRep(..) )
-import Unique
 import BasicTypes	( Arity )
 import StaticFlags
 
-import Bitmap
-import Data.Bits
-
 import Constants
 import Util
 import Data.List
@@ -293,6 +287,10 @@ mkVirtHeapOffsets is_thunk things
       = (wds_so_far + lRepSizeW (toLRep rep), 
 	 (NonVoid thing, hdr_size + wds_so_far))
 
+mkVirtConstrOffsets :: [(PrimRep,a)] -> (WordOff, WordOff, [(NonVoid a, VirtualHpOffset)])
+-- Just like mkVirtHeapOffsets, but for constructors
+mkVirtConstrOffsets = mkVirtHeapOffsets False
+
 
 -------------------------------------------------------------------------
 --
@@ -309,29 +307,16 @@ mkVirtHeapOffsets is_thunk things
 -- bring in ARG_P, ARG_N, etc.
 #include "../includes/rts/storage/FunTypes.h"
 
--------------------------
--- argDescrType :: ArgDescr -> StgHalfWord
--- -- The "argument type" RTS field type
--- argDescrType (ArgSpec n) = n
--- argDescrType (ArgGen liveness)
---   | isBigLiveness liveness = ARG_GEN_BIG
---   | otherwise		   = ARG_GEN
-
-
 mkArgDescr :: Name -> [Id] -> FCode ArgDescr
-mkArgDescr nm args 
+mkArgDescr _nm args 
   = case stdPattern arg_reps of
 	Just spec_id -> return (ArgSpec spec_id)
-	Nothing      -> do { liveness <- mkLiveness nm size bitmap
-			   ; return (ArgGen liveness) }
+	Nothing      -> return (ArgGen arg_bits)
   where
+    arg_bits = argBits arg_reps
     arg_reps = filter isNonV (map (toLRep . idPrimRep) args)
 	-- Getting rid of voids eases matching of standard patterns
 
-    bitmap   = mkBitmap arg_bits
-    arg_bits = argBits arg_reps
-    size     = length arg_bits
-
 argBits :: [LRep] -> [Bool]	-- True for non-ptr, False for ptr
 argBits [] 		= []
 argBits (P   : args) = False : argBits args
@@ -370,78 +355,6 @@ stdPattern reps
 
 -------------------------------------------------------------------------
 --
---	Liveness info
---
--------------------------------------------------------------------------
-
--- TODO: This along with 'mkArgDescr' should be unified
--- with 'CmmInfo.mkLiveness'.  However that would require
--- potentially invasive changes to the 'ClosureInfo' type.
--- For now, 'CmmInfo.mkLiveness' handles only continuations and
--- this one handles liveness everything else.  Another distinction
--- between these two is that 'CmmInfo.mkLiveness' information
--- about the stack layout, and this one is information about
--- the heap layout of PAPs.
-mkLiveness :: Name -> Int -> Bitmap -> FCode Liveness
-mkLiveness name size bits
-  | size > mAX_SMALL_BITMAP_SIZE		-- Bitmap does not fit in one word
-  = do	{ let lbl = mkBitmapLabel (getUnique name)
-	; emitRODataLits lbl ( mkWordCLit (fromIntegral size)
-		             : map mkWordCLit bits)
-	; return (BigLiveness lbl) }
-  
-  | otherwise		-- Bitmap fits in one word
-  = let
-        small_bits = case bits of 
-			[]  -> 0
-                        [b] -> b
-			_   -> panic "livenessToAddrMode"
-    in
-    return (smallLiveness size small_bits)
-
-smallLiveness :: Int -> StgWord -> Liveness
-smallLiveness size small_bits = SmallLiveness bits
-  where bits = fromIntegral size .|. (small_bits `shiftL` bITMAP_BITS_SHIFT)
-
--------------------
--- isBigLiveness :: Liveness -> Bool
--- isBigLiveness (BigLiveness _)   = True
--- isBigLiveness (SmallLiveness _) = False
-
--------------------
--- mkLivenessCLit :: Liveness -> CmmLit
--- mkLivenessCLit (BigLiveness lbl)    = CmmLabel lbl
--- mkLivenessCLit (SmallLiveness bits) = mkWordCLit bits
-
-
--------------------------------------------------------------------------
---
---		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): 
--- GET_NON_PTRS(), GET_PTRS(), GET_LIVENESS().
--------------------------------------------------------------------------
-
-{- 	Not used in new code gen
-mkRegLiveness :: [(Id, GlobalReg)] -> Int -> Int -> StgWord
-mkRegLiveness regs ptrs nptrs
-  = (fromIntegral nptrs `shiftL` 16) .|. 
-    (fromIntegral ptrs  `shiftL` 24) .|.
-    all_non_ptrs `xor` reg_bits regs
-  where
-    all_non_ptrs = 0xff
-
-    reg_bits [] = 0
-    reg_bits ((id, VanillaReg i) : regs) | isGcPtrRep (idPrimRep id)
-  	= (1 `shiftL` (i - 1)) .|. reg_bits regs
-    reg_bits (_ : regs)
-	= reg_bits regs
--}
- 
--------------------------------------------------------------------------
---
 --	Generating the info table and code for a closure
 --
 -------------------------------------------------------------------------
@@ -479,27 +392,19 @@ emitClosureProcAndInfoTable top_lvl bndr cl_info args body
 emitClosureAndInfoTable ::
   ClosureInfo -> Convention -> [LocalReg] -> FCode () -> FCode ()
 emitClosureAndInfoTable cl_info conv args body
-  = do { info <- mkCmmInfo cl_info
+  = do { let info = mkCmmInfo cl_info
        ; blks <- getCode body
        ; emitProcWithConvention conv info (entryLabelFromCI cl_info) args blks
        }
 
 -- Convert from 'ClosureInfo' to 'CmmInfoTable'.
--- Not used for return points.  (The 'smRepClosureTypeInt' call would panic.)
-mkCmmInfo :: ClosureInfo -> FCode CmmInfoTable
+-- Not used for return points.
+mkCmmInfo :: ClosureInfo -> CmmInfoTable
 mkCmmInfo cl_info
-  = do	{ info <- closureTypeInfo cl_info k_with_con_name return 
-        ; prof <- if opt_SccProfilingOn then
-                    do fd_lit <- mkStringCLit (closureTypeDescr cl_info)
-	               ad_lit <- mkStringCLit (closureValDescr  cl_info)
-	               return $ ProfilingInfo fd_lit ad_lit
-                  else return $ ProfilingInfo (mkIntCLit 0) (mkIntCLit 0)
-	; return (CmmInfoTable (infoTableLabelFromCI cl_info) (isStaticClosure cl_info) prof cl_type info) }
-  where
-    k_with_con_name con_info con info_lbl =
-      do cstr <- mkByteStringCLit $ dataConIdentity con
-         return $ con_info $ makeRelativeRefTo info_lbl cstr
-    cl_type  = smRepClosureTypeInt (closureSMRep cl_info)
+  = CmmInfoTable { cit_lbl  = infoTableLabelFromCI cl_info,
+                   cit_rep  = closureSMRep cl_info,
+                   cit_prof = closureProf cl_info,
+                   cit_srt  = closureSRT cl_info }
 
 -----------------------------------------------------------------------------
 --
@@ -612,37 +517,3 @@ funInfoTable info_ptr
   = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
 				-- Past the entry code pointer
 
--------------------------------------------------------------------------
---
---	Static reference tables
---
--------------------------------------------------------------------------
-
--- srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
--- srtLabelAndLength NoC_SRT _		
---   = (zeroCLit, 0)
--- srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
---   = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
-
--------------------------------------------------------------------------
---
---	Position independent code
---
--------------------------------------------------------------------------
--- In order to support position independent code, we mustn't put absolute
--- references into read-only space. Info tables in the tablesNextToCode
--- case must be in .text, which is read-only, so we doctor the CmmLits
--- to use relative offsets instead.
-
--- Note that this is done even when the -fPIC flag is not specified,
--- as we want to keep binary compatibility between PIC and non-PIC.
-
-makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
-        
-makeRelativeRefTo info_lbl (CmmLabel lbl)
-  | tablesNextToCode
-  = CmmLabelDiffOff lbl info_lbl 0
-makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
-  | tablesNextToCode
-  = CmmLabelDiffOff lbl info_lbl off
-makeRelativeRefTo _ lit = lit
diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs
index d06b581f26..c8da75003a 100644
--- a/compiler/codeGen/StgCmmMonad.hs
+++ b/compiler/codeGen/StgCmmMonad.hs
@@ -13,7 +13,7 @@ module StgCmmMonad (
 	returnFC, fixC, fixC_, nopC, whenC, 
 	newUnique, newUniqSupply, 
 
-	emit, emitData, emitProc, emitProcWithConvention, emitSimpleProc,
+	emit, emitDecl, emitProc, emitProcWithConvention, emitSimpleProc,
 
 	getCmm, cgStmtsToBlocks,
 	getCodeR, getCode, getHeapUsage,
@@ -49,13 +49,11 @@ module StgCmmMonad (
 
 #include "HsVersions.h"
 
+import Cmm
 import StgCmmClosure
 import DynFlags
 import MkGraph
 import BlockId
-import CmmDecl
-import CmmExpr
-import CmmNode (UpdFrameOffset)
 import CLabel
 import TyCon	( PrimRep )
 import SMRep
@@ -593,12 +591,10 @@ emit ag
   = do	{ state <- getState
 	; setState $ state { cgs_stmts = cgs_stmts state <*> ag } }
 
-emitData :: Section -> CmmStatics -> FCode ()
-emitData sect lits
+emitDecl :: CmmTop -> FCode ()
+emitDecl decl
   = do 	{ state <- getState
-	; setState $ state { cgs_tops = cgs_tops state `snocOL` data_block } }
-  where
-    data_block = CmmData sect lits
+	; setState $ state { cgs_tops = cgs_tops state `snocOL` decl } }
 
 emitProcWithConvention :: Convention -> CmmInfoTable -> CLabel -> [CmmFormal] ->
                           CmmAGraph -> FCode ()
@@ -618,7 +614,7 @@ emitSimpleProc :: CLabel -> CmmAGraph -> FCode ()
 emitSimpleProc lbl code = 
   emitProc CmmNonInfoTable lbl [] code
 
-getCmm :: FCode () -> FCode Cmm
+getCmm :: FCode () -> FCode CmmPgm
 -- 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)
@@ -626,7 +622,7 @@ getCmm code
   = do	{ state1 <- getState
 	; ((), state2) <- withState code (state1 { cgs_tops  = nilOL })
 	; setState $ state2 { cgs_tops = cgs_tops state1 } 
-	; return (Cmm (fromOL (cgs_tops state2))) }
+        ; return (fromOL (cgs_tops state2)) }
 
 -- ----------------------------------------------------------------------------
 -- CgStmts
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index b68bb601eb..103929c3b7 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -24,8 +24,7 @@ import StgCmmProf
 import BasicTypes
 import MkGraph
 import StgSyn
-import CmmDecl
-import CmmExpr
+import Cmm
 import Type	( Type, tyConAppTyCon )
 import TyCon
 import CLabel
diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs
index 08bf52952c..ca116f2218 100644
--- a/compiler/codeGen/StgCmmProf.hs
+++ b/compiler/codeGen/StgCmmProf.hs
@@ -39,8 +39,7 @@ import StgCmmMonad
 import SMRep
 
 import MkGraph
-import CmmExpr
-import CmmDecl
+import Cmm
 import CmmUtils
 import CLabel
 
@@ -358,8 +357,8 @@ initCostCentres (local_CCs, ___extern_CCs, singleton_CCSs)
 
 emitCostCentreDecl :: CostCentre -> FCode ()
 emitCostCentreDecl cc = do 
-  { label <- mkStringCLit (costCentreUserName cc)
-  ; modl  <- mkStringCLit (Module.moduleNameString 
+  { label <- newStringCLit (costCentreUserName cc)
+  ; modl  <- newStringCLit (Module.moduleNameString 
                	               (Module.moduleName (cc_mod cc)))
                 -- All cost centres will be in the main package, since we
                 -- don't normally use -auto-all or add SCCs to other packages.
diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs
index a02a698410..8db4d3e829 100644
--- a/compiler/codeGen/StgCmmTicky.hs
+++ b/compiler/codeGen/StgCmmTicky.hs
@@ -45,7 +45,6 @@ module StgCmmTicky (
 import StgCmmClosure
 import StgCmmUtils
 import StgCmmMonad
-import SMRep
 
 import StgSyn
 import CmmExpr
@@ -89,8 +88,8 @@ emitTickyCounter :: ClosureInfo -> [Id] -> FCode ()
 emitTickyCounter cl_info args
   = ifTicky $
     do	{ mod_name <- getModuleName
-	; fun_descr_lit <- mkStringCLit (fun_descr mod_name)
-	; arg_descr_lit <- mkStringCLit arg_descr
+	; fun_descr_lit <- newStringCLit (fun_descr mod_name)
+	; arg_descr_lit <- newStringCLit arg_descr
 	; emitDataLits ticky_ctr_label 	-- Must match layout of StgEntCounter
 -- krc: note that all the fields are I32 now; some were I16 before, 
 -- but the code generator wasn't handling that properly and it led to chaos, 
@@ -270,18 +269,17 @@ tickyDynAlloc :: ClosureInfo -> FCode ()
 -- Called when doing a dynamic heap allocation
 tickyDynAlloc cl_info
   = ifTicky $
-    case smRepClosureType (closureSMRep cl_info) of
-	Just Constr           -> tick_alloc_con
-	Just ConstrNoCaf      -> tick_alloc_con
-	Just Fun	      -> tick_alloc_fun
-	Just Thunk 	      -> tick_alloc_thk
-	Just ThunkSelector    -> tick_alloc_thk
-        -- black hole
-        Nothing               -> return ()
+    case () of
+      _ | Just _ <- maybeIsLFCon lf -> tick_alloc_con
+	| isLFThunk lf              -> tick_alloc_thk
+        | isLFReEntrant lf          -> tick_alloc_fun
+        | otherwise                 -> return ()
   where
+    lf = closureLFInfo cl_info
+
 	-- will be needed when we fill in stubs
-    _cl_size   =	closureSize cl_info
-    _slop_size = slopSize cl_info
+    _cl_size   = closureSize cl_info
+--    _slop_size = slopSize cl_info
 
     tick_alloc_thk 
 	| closureUpdReqd cl_info = tick_alloc_up_thk
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index 74da7317d4..4575a0384e 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -36,7 +36,7 @@ module StgCmmUtils (
 
 	addToMem, addToMemE, addToMemLbl,
 	mkWordCLit,
-	mkStringCLit, mkByteStringCLit,
+	newStringCLit, newByteStringCLit,
 	packHalfWordsCLit,
 	blankWord,
 
@@ -48,9 +48,8 @@ module StgCmmUtils (
 
 import StgCmmMonad
 import StgCmmClosure
+import Cmm
 import BlockId
-import CmmDecl
-import CmmExpr hiding (regUsedIn)
 import MkGraph
 import CLabel
 import CmmUtils
@@ -73,7 +72,6 @@ import FastString
 import Outputable
 
 import Data.Char
-import Data.Bits
 import Data.Word
 import Data.Maybe
 
@@ -85,10 +83,18 @@ import Data.Maybe
 -------------------------------------------------------------------------
 
 cgLit :: Literal -> FCode CmmLit
-cgLit (MachStr s) = mkByteStringCLit (bytesFS s)
+cgLit (MachStr s) = newByteStringCLit (bytesFS s)
  -- not unpackFS; we want the UTF-8 byte stream.
 cgLit other_lit   = return (mkSimpleLit other_lit)
 
+mkLtOp :: Literal -> MachOp
+-- On signed literals we must do a signed comparison
+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)))
+				-- ToDo: seems terribly indirect!
+
 mkSimpleLit :: Literal -> CmmLit
 mkSimpleLit (MachChar	c)    = CmmInt (fromIntegral (ord c)) wordWidth
 mkSimpleLit MachNullAddr      = zeroCLit
@@ -105,131 +111,6 @@ mkSimpleLit (MachLabel fs ms fod)
 		labelSrc = ForeignLabelInThisPackage	
 mkSimpleLit other	      = pprPanic "mkSimpleLit" (ppr other)
 
-mkLtOp :: Literal -> MachOp
--- On signed literals we must do a signed comparison
-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)))
-				-- ToDo: seems terribly indirect!
-
-
----------------------------------------------------
---
---	Cmm data type functions
---
----------------------------------------------------
-
--- The "B" variants take byte offsets
-cmmRegOffB :: CmmReg -> ByteOff -> CmmExpr
-cmmRegOffB = cmmRegOff
-
-cmmOffsetB :: CmmExpr -> ByteOff -> CmmExpr
-cmmOffsetB = cmmOffset
-
-cmmOffsetExprB :: CmmExpr -> CmmExpr -> CmmExpr
-cmmOffsetExprB = cmmOffsetExpr
-
-cmmLabelOffB :: CLabel -> ByteOff -> CmmLit
-cmmLabelOffB = cmmLabelOff
-
-cmmOffsetLitB :: CmmLit -> ByteOff -> CmmLit
-cmmOffsetLitB = cmmOffsetLit
-
------------------------
--- The "W" variants take word offsets
-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 wordWidth e wd_off
-
-cmmOffsetW :: CmmExpr -> WordOff -> CmmExpr
-cmmOffsetW e n = cmmOffsetB e (wORD_SIZE * n)
-
-cmmRegOffW :: CmmReg -> WordOff -> CmmExpr
-cmmRegOffW reg wd_off = cmmRegOffB reg (wd_off * wORD_SIZE)
-
-cmmOffsetLitW :: CmmLit -> WordOff -> CmmLit
-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 -> CmmType -> CmmExpr
-cmmLoadIndexW base off ty = CmmLoad (cmmOffsetW base off) ty
-
------------------------
-cmmULtWord, cmmUGeWord, cmmUGtWord, cmmSubWord,
-  cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord,
-  cmmUShrWord, cmmAddWord, cmmMulWord
-  :: CmmExpr -> CmmExpr -> CmmExpr
-cmmOrWord  e1 e2 = CmmMachOp mo_wordOr  [e1, e2]
-cmmAndWord e1 e2 = CmmMachOp mo_wordAnd [e1, e2]
-cmmNeWord  e1 e2 = CmmMachOp mo_wordNe  [e1, e2]
-cmmEqWord  e1 e2 = CmmMachOp mo_wordEq  [e1, e2]
-cmmULtWord e1 e2 = CmmMachOp mo_wordULt [e1, e2]
-cmmUGeWord e1 e2 = CmmMachOp mo_wordUGe [e1, e2]
-cmmUGtWord e1 e2 = CmmMachOp mo_wordUGt [e1, e2]
---cmmShlWord e1 e2 = CmmMachOp mo_wordShl [e1, e2]
-cmmUShrWord e1 e2 = CmmMachOp mo_wordUShr [e1, e2]
-cmmAddWord e1 e2 = CmmMachOp mo_wordAdd [e1, e2]
-cmmSubWord e1 e2 = CmmMachOp mo_wordSub [e1, e2]
-cmmMulWord e1 e2 = CmmMachOp mo_wordMul [e1, e2]
-
-cmmNegate :: CmmExpr -> CmmExpr
-cmmNegate (CmmLit (CmmInt n rep)) = CmmLit (CmmInt (-n) rep)
-cmmNegate e			  = CmmMachOp (MO_S_Neg (cmmExprWidth e)) [e]
-
-blankWord :: CmmStatic
-blankWord = CmmUninitialised wORD_SIZE
-
--- Tagging --
--- Tag bits mask
---cmmTagBits = CmmLit (mkIntCLit tAG_BITS)
-cmmTagMask, cmmPointerMask :: CmmExpr
-cmmTagMask = CmmLit (mkIntCLit tAG_MASK)
-cmmPointerMask = CmmLit (mkIntCLit (complement tAG_MASK))
-
--- Used to untag a possibly tagged pointer
--- A static label need not be untagged
-cmmUntag, cmmGetTag :: CmmExpr -> CmmExpr
-cmmUntag e@(CmmLit (CmmLabel _)) = e
--- Default case
-cmmUntag e = (e `cmmAndWord` cmmPointerMask)
-
-cmmGetTag e = (e `cmmAndWord` cmmTagMask)
-
--- Test if a closure pointer is untagged
-cmmIsTagged :: CmmExpr -> CmmExpr
-cmmIsTagged e = (e `cmmAndWord` cmmTagMask)
-                 `cmmNeWord` CmmLit zeroCLit
-
-cmmConstrTag, cmmConstrTag1 :: CmmExpr -> CmmExpr
-cmmConstrTag e = (e `cmmAndWord` cmmTagMask) `cmmSubWord` (CmmLit (mkIntCLit 1))
--- Get constructor tag, but one based.
-cmmConstrTag1 e = e `cmmAndWord` cmmTagMask
-
------------------------
---	Making literals
-
-mkWordCLit :: StgWord -> CmmLit
-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
--- at the lower address, and the upper_half_word is at the 
--- higher address
--- ToDo: consider using half-word lits instead
--- 	 but be careful: that's vulnerable when reversed
-packHalfWordsCLit lower_half_word upper_half_word
-#ifdef WORDS_BIGENDIAN
-   = mkWordCLit ((fromIntegral lower_half_word `shiftL` hALF_WORD_SIZE_IN_BITS)
-		 .|. fromIntegral upper_half_word)
-#else 
-   = mkWordCLit ((fromIntegral lower_half_word) 
-		 .|. (fromIntegral upper_half_word `shiftL` hALF_WORD_SIZE_IN_BITS))
-#endif
-
 --------------------------------------------------------------------------
 --
 -- Incrementing a memory location
@@ -507,44 +388,23 @@ baseRegOffset reg		  = pprPanic "baseRegOffset:" (ppr reg)
 
 emitDataLits :: CLabel -> [CmmLit] -> FCode ()
 -- Emit a data-segment data block
-emitDataLits lbl lits
-  = emitData Data (Statics lbl $ map CmmStaticLit lits)
-
-mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatics info stmt
--- Emit a data-segment data block
-mkDataLits lbl lits
-  = CmmData Data (Statics lbl $ map CmmStaticLit lits)
+emitDataLits lbl lits = emitDecl (mkDataLits Data lbl lits)
 
 emitRODataLits :: CLabel -> [CmmLit] -> FCode ()
 -- Emit a read-only data block
-emitRODataLits lbl lits
-  = emitData section (Statics lbl $ map CmmStaticLit lits)
-  where section | any needsRelocation lits = RelocatableReadOnlyData
-                | otherwise                = ReadOnlyData
-        needsRelocation (CmmLabel _)      = True
-        needsRelocation (CmmLabelOff _ _) = True
-        needsRelocation _                 = False
-
-mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatics info stmt
-mkRODataLits lbl lits
-  = CmmData section (Statics lbl $ map CmmStaticLit lits)
-  where section | any needsRelocation lits = RelocatableReadOnlyData
-                | otherwise                = ReadOnlyData
-        needsRelocation (CmmLabel _)      = True
-        needsRelocation (CmmLabelOff _ _) = True
-        needsRelocation _                 = False
-
-mkStringCLit :: String -> FCode CmmLit
+emitRODataLits lbl lits = emitDecl (mkRODataLits lbl lits)
+
+newStringCLit :: String -> FCode CmmLit
 -- Make a global definition for the string,
 -- and return its label
-mkStringCLit str = mkByteStringCLit (map (fromIntegral . ord) str)
+newStringCLit str = newByteStringCLit (map (fromIntegral . ord) str)
 
-mkByteStringCLit :: [Word8] -> FCode CmmLit
-mkByteStringCLit bytes
+newByteStringCLit :: [Word8] -> FCode CmmLit
+newByteStringCLit bytes
   = do 	{ uniq <- newUnique
-	; let lbl = mkStringLitLabel uniq
-	; emitData ReadOnlyData $ Statics lbl [CmmString bytes]
-	; return (CmmLabel lbl) }
+	; let (lit, decl) = mkByteStringCLit uniq bytes
+	; emitDecl decl
+	; return lit }
 
 -------------------------------------------------------------------------
 --
@@ -658,14 +518,7 @@ unscramble vertices
 	mk_graph (reg, rhs) = mkAssign (CmmLocal reg) rhs
 
 mustFollow :: Stmt -> Stmt -> Bool
-(reg, _) `mustFollow` (_, rhs) = reg `regUsedIn` rhs
-
-regUsedIn :: LocalReg -> CmmExpr -> Bool
-reg  `regUsedIn` CmmLoad e  _ 	 	     = reg `regUsedIn` e
-reg  `regUsedIn` CmmReg (CmmLocal reg')      = reg == reg'
-reg  `regUsedIn` CmmRegOff (CmmLocal reg') _ = reg == reg'
-reg  `regUsedIn` CmmMachOp _ es   	     = any (reg `regUsedIn`) es
-_reg `regUsedIn` _other		 	     = False    	-- The CmmGlobal cases
+(reg, _) `mustFollow` (_, rhs) = CmmLocal reg `regUsedIn` rhs
 
 -------------------------------------------------------------------------
 --	mkSwitch