Snapshot of codegen refactoring to share with simonpj

60 files changed, 1541 insertions, 1979 deletions

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index fdab13264f..68f13c937e 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -22,7 +22,7 @@ module CLabel (
 	mkSRTLabel,
 	mkInfoTableLabel,
 	mkEntryLabel,
-	mkSlowEntryLabel,
+	mkSlowEntryLabel, slowEntryFromInfoLabel,
 	mkConEntryLabel,
 	mkStaticConEntryLabel,
 	mkRednCountsLabel,
@@ -354,8 +354,10 @@ data DynamicLinkerLabelInfo
 
 -- Constructing IdLabels 
 -- These are always local:
+mkSlowEntryLabel      	name c 	       = IdLabel name  c Slow
+slowEntryFromInfoLabel (IdLabel n c _) = IdLabel n c Slow
+
 mkSRTLabel		name c	= IdLabel name  c SRT
-mkSlowEntryLabel      	name c 	= IdLabel name  c Slow
 mkRednCountsLabel     	name c 	= IdLabel name  c RednCounts
 
 -- These have local & (possibly) external variants:
@@ -372,8 +374,8 @@ mkLocalConInfoTableLabel    c con = IdLabel con c ConInfoTable
 mkLocalConEntryLabel	    c con = IdLabel con c ConEntry
 mkLocalStaticInfoTableLabel c con = IdLabel con c StaticInfoTable
 mkLocalStaticConEntryLabel  c con = IdLabel con c StaticConEntry
-mkConInfoTableLabel name    c     = IdLabel    name c ConInfoTable
-mkStaticInfoTableLabel name c     = IdLabel    name c StaticInfoTable
+mkConInfoTableLabel name    c     = IdLabel name c ConInfoTable
+mkStaticInfoTableLabel name c     = IdLabel name c StaticInfoTable
 
 mkConEntryLabel name        c     = IdLabel name c ConEntry
 mkStaticConEntryLabel name  c     = IdLabel name c StaticConEntry
diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index 49ea6dd461..93ac141ac7 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -8,39 +8,84 @@
 {-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
 #endif
 
-module Cmm
-  ( CmmGraph, GenCmmGraph(..), CmmBlock
-  , CmmStackInfo(..), CmmTopInfo(..), Cmm, CmmTop
-  , CmmReplGraph, GenCmmReplGraph, CmmFwdRewrite, CmmBwdRewrite
-
-  , modifyGraph
-  , lastNode, replaceLastNode, insertBetween
-  , ofBlockMap, toBlockMap, insertBlock
-  , ofBlockList, toBlockList, bodyToBlockList
-  , foldGraphBlocks, mapGraphNodes, postorderDfs
-
-  , analFwd, analBwd, analRewFwd, analRewBwd
-  , dataflowPassFwd, dataflowPassBwd
-  , module CmmNode
-  )
-where
-
+module Cmm (
+     -- * Cmm top-level datatypes
+     CmmPgm, GenCmmPgm,
+     CmmTop, GenCmmTop(..),
+     CmmGraph, GenCmmGraph(..),
+     CmmBlock,
+     Section(..), CmmStatics(..), CmmStatic(..),
+
+     -- * Cmm graphs
+     CmmReplGraph, GenCmmReplGraph, CmmFwdRewrite, CmmBwdRewrite,
+   
+     -- * Info Tables
+     CmmTopInfo(..), CmmStackInfo(..), CmmInfoTable(..),
+     ClosureTypeInfo(..), 
+     C_SRT(..), needsSRT,
+     ProfilingInfo(..), ConstrDescription, 
+
+     -- * Statements, expressions and types
+     module CmmNode,
+     module CmmExpr,
+  ) where
+
+import CLabel
 import BlockId
-import CmmDecl
 import CmmNode
 import OptimizationFuel as F
 import SMRep
-import UniqSupply
-
+import CmmExpr
 import Compiler.Hoopl
-import Control.Monad
-import Data.Maybe
-import Panic
+
+import Data.Word        ( Word8 )
 
 #include "HsVersions.h"
 
--------------------------------------------------
--- CmmBlock, CmmGraph and Cmm
+-----------------------------------------------------------------------------
+--  Cmm, GenCmm
+-----------------------------------------------------------------------------
+
+-- A file is a list of top-level chunks.  These may be arbitrarily
+-- re-orderd during code generation.
+
+-- GenCmm is abstracted over
+--   d, the type of static data elements in CmmData
+--   h, the static info preceding the code of a CmmProc
+--   g, the control-flow graph of a CmmProc
+--
+-- We expect there to be two main instances of this type:
+--   (a) C--, i.e. populated with various C-- constructs
+--       (Cmm and RawCmm in OldCmm.hs)
+--   (b) Native code, populated with data/instructions
+--
+-- A second family of instances based on Hoopl is in Cmm.hs.
+--
+type GenCmmPgm d h g = [GenCmmTop d h g]
+
+type CmmPgm = GenCmmPgm CmmStatics CmmTopInfo CmmGraph
+
+-----------------------------------------------------------------------------
+--  CmmTop, GenCmmTop
+-----------------------------------------------------------------------------
+
+-- | A top-level chunk, abstracted over the type of the contents of
+-- the basic blocks (Cmm or instructions are the likely instantiations).
+data GenCmmTop d h g
+  = CmmProc     -- A procedure
+     h                 -- Extra header such as the info table
+     CLabel            -- Entry label
+     g                 -- Control-flow graph for the procedure's code
+
+  | CmmData     -- Static data
+        Section
+        d
+
+type CmmTop = GenCmmTop CmmStatics CmmTopInfo CmmGraph
+
+-----------------------------------------------------------------------------
+--     Graphs
+-----------------------------------------------------------------------------
 
 type CmmGraph = GenCmmGraph CmmNode
 data GenCmmGraph n = CmmGraph { g_entry :: BlockId, g_graph :: Graph n C C }
@@ -51,131 +96,66 @@ type GenCmmReplGraph n e x = FuelUniqSM (Maybe (Graph n e x))
 type CmmFwdRewrite f = FwdRewrite FuelUniqSM CmmNode f
 type CmmBwdRewrite f = BwdRewrite FuelUniqSM CmmNode f
 
-data CmmStackInfo = StackInfo {arg_space :: ByteOff, updfr_space :: Maybe ByteOff}
+-----------------------------------------------------------------------------
+--     Info Tables
+-----------------------------------------------------------------------------
+
 data CmmTopInfo   = TopInfo {info_tbl :: CmmInfoTable, stack_info :: CmmStackInfo}
-type Cmm          = GenCmm    CmmStatics CmmTopInfo CmmGraph
-type CmmTop       = GenCmmTop CmmStatics CmmTopInfo CmmGraph
-
--------------------------------------------------
--- Manipulating CmmGraphs
-
-modifyGraph :: (Graph n C C -> Graph n' C C) -> GenCmmGraph n -> GenCmmGraph n'
-modifyGraph f g = CmmGraph {g_entry=g_entry g, g_graph=f (g_graph g)}
-
-toBlockMap :: CmmGraph -> LabelMap CmmBlock
-toBlockMap (CmmGraph {g_graph=GMany NothingO body NothingO}) = body
-
-ofBlockMap :: BlockId -> LabelMap CmmBlock -> CmmGraph
-ofBlockMap entry bodyMap = CmmGraph {g_entry=entry, g_graph=GMany NothingO bodyMap NothingO}
-
-insertBlock :: CmmBlock -> LabelMap CmmBlock -> LabelMap CmmBlock
-insertBlock block map =
-  ASSERT (isNothing $ mapLookup id map)
-  mapInsert id block map
-  where id = entryLabel block
-
-toBlockList :: CmmGraph -> [CmmBlock]
-toBlockList g = mapElems $ toBlockMap g
-
-ofBlockList :: BlockId -> [CmmBlock] -> CmmGraph
-ofBlockList entry blocks = CmmGraph {g_entry=entry, g_graph=GMany NothingO body NothingO}
-  where body = foldr addBlock emptyBody blocks
-
-bodyToBlockList :: Body CmmNode -> [CmmBlock]
-bodyToBlockList body = mapElems body
-
-mapGraphNodes :: ( CmmNode C O -> CmmNode C O
-                 , CmmNode O O -> CmmNode O O
-                 , CmmNode O C -> CmmNode O C)
-              -> CmmGraph -> CmmGraph
-mapGraphNodes funs@(mf,_,_) g =
-  ofBlockMap (entryLabel $ mf $ CmmEntry $ g_entry g) $ mapMap (blockMapNodes3 funs) $ toBlockMap g
-
-foldGraphBlocks :: (CmmBlock -> a -> a) -> a -> CmmGraph -> a
-foldGraphBlocks k z g = mapFold k z $ toBlockMap g
-
-postorderDfs :: CmmGraph -> [CmmBlock]
-postorderDfs g = postorder_dfs_from (toBlockMap g) (g_entry g)
-
--------------------------------------------------
--- Manipulating CmmBlocks
-
-lastNode :: CmmBlock -> CmmNode O C
-lastNode block = foldBlockNodesF3 (nothing, nothing, const) block ()
-  where nothing :: a -> b -> ()
-        nothing _ _ = ()
-
-replaceLastNode :: Block CmmNode e C -> CmmNode O C -> Block CmmNode e C
-replaceLastNode block last = blockOfNodeList (first, middle, JustC last)
-  where (first, middle, _) = blockToNodeList block
-
-----------------------------------------------------------------------
------ Splicing between blocks
--- Given a middle node, a block, and a successor BlockId,
--- we can insert the middle node between the block and the successor.
--- We return the updated block and a list of new blocks that must be added
--- to the graph.
--- The semantics is a bit tricky. We consider cases on the last node:
--- o For a branch, we can just insert before the branch,
---   but sometimes the optimizer does better if we actually insert
---   a fresh basic block, enabling some common blockification.
--- o For a conditional branch, switch statement, or call, we must insert
---   a new basic block.
--- o For a jump or return, this operation is impossible.
-
-insertBetween :: MonadUnique m => CmmBlock -> [CmmNode O O] -> BlockId -> m (CmmBlock, [CmmBlock])
-insertBetween b ms succId = insert $ lastNode b
-  where insert :: MonadUnique m => CmmNode O C -> m (CmmBlock, [CmmBlock])
-        insert (CmmBranch bid) =
-          if bid == succId then
-            do (bid', bs) <- newBlocks
-               return (replaceLastNode b (CmmBranch bid'), bs)
-          else panic "tried invalid block insertBetween"
-        insert (CmmCondBranch c t f) =
-          do (t', tbs) <- if t == succId then newBlocks else return $ (t, [])
-             (f', fbs) <- if f == succId then newBlocks else return $ (f, [])
-             return (replaceLastNode b (CmmCondBranch c t' f'), tbs ++ fbs)
-        insert (CmmSwitch e ks) =
-          do (ids, bs) <- mapAndUnzipM mbNewBlocks ks
-             return (replaceLastNode b (CmmSwitch e ids), join bs)
-        insert (CmmCall {}) =
-          panic "unimp: insertBetween after a call -- probably not a good idea"
-        insert (CmmForeignCall {}) =
-          panic "unimp: insertBetween after a foreign call -- probably not a good idea"
-
-        newBlocks :: MonadUnique m => m (BlockId, [CmmBlock])
-        newBlocks = do id <- liftM mkBlockId $ getUniqueM
-                       return $ (id, [blockOfNodeList (JustC (CmmEntry id), ms, JustC (CmmBranch succId))])
-        mbNewBlocks :: MonadUnique m => Maybe BlockId -> m (Maybe BlockId, [CmmBlock])
-        mbNewBlocks (Just k) = if k == succId then liftM fstJust newBlocks
-                               else return (Just k, [])
-        mbNewBlocks Nothing  = return (Nothing, [])
-        fstJust (id, bs) = (Just id, bs)
-
--------------------------------------------------
--- Running dataflow analysis and/or rewrites
-
--- Constructing forward and backward analysis-only pass
-analFwd    :: Monad m => DataflowLattice f -> FwdTransfer n f -> FwdPass m n f
-analBwd    :: Monad m => DataflowLattice f -> BwdTransfer n f -> BwdPass m n f
-
-analFwd lat xfer = analRewFwd lat xfer noFwdRewrite
-analBwd lat xfer = analRewBwd lat xfer noBwdRewrite
-
--- Constructing forward and backward analysis + rewrite pass
-analRewFwd :: Monad m => DataflowLattice f -> FwdTransfer n f -> FwdRewrite m n f -> FwdPass m n f
-analRewBwd :: Monad m => DataflowLattice f -> BwdTransfer n f -> BwdRewrite m n f -> BwdPass m n f
-
-analRewFwd lat xfer rew = FwdPass {fp_lattice = lat, fp_transfer = xfer, fp_rewrite = rew}
-analRewBwd lat xfer rew = BwdPass {bp_lattice = lat, bp_transfer = xfer, bp_rewrite = rew}
-
--- Running forward and backward dataflow analysis + optional rewrite
-dataflowPassFwd :: NonLocal n => GenCmmGraph n -> [(BlockId, f)] -> FwdPass FuelUniqSM n f -> FuelUniqSM (GenCmmGraph n, BlockEnv f)
-dataflowPassFwd (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd = do
-  (graph, facts, NothingO) <- analyzeAndRewriteFwd fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts)
-  return (CmmGraph {g_entry=entry, g_graph=graph}, facts)
-
-dataflowPassBwd :: NonLocal n => GenCmmGraph n -> [(BlockId, f)] -> BwdPass FuelUniqSM n f -> FuelUniqSM (GenCmmGraph n, BlockEnv f)
-dataflowPassBwd (CmmGraph {g_entry=entry, g_graph=graph}) facts bwd = do
-  (graph, facts, NothingO) <- analyzeAndRewriteBwd bwd (JustC [entry]) graph (mkFactBase (bp_lattice bwd) facts)
-  return (CmmGraph {g_entry=entry, g_graph=graph}, facts)
+
+data CmmStackInfo
+   = StackInfo {
+       arg_space :: ByteOff,            -- XXX: comment?
+       updfr_space :: Maybe ByteOff     -- XXX: comment?
+   }
+
+-- | Info table as a haskell data type
+data CmmInfoTable
+  = CmmInfoTable {
+      cit_lbl  :: CLabel, -- Info table label
+      cit_rep  :: SMRep,
+      cit_prof :: ProfilingInfo,
+      cit_srt  :: C_SRT
+    }
+  | CmmNonInfoTable   -- Procedure doesn't need an info table
+
+data ProfilingInfo
+  = NoProfilingInfo
+  | ProfilingInfo [Word8] [Word8] -- closure_type, closure_desc
+
+-- 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
+
+-----------------------------------------------------------------------------
+--              Static Data
+-----------------------------------------------------------------------------
+
+data Section
+  = Text
+  | Data
+  | ReadOnlyData
+  | RelocatableReadOnlyData
+  | UninitialisedData
+  | ReadOnlyData16      -- .rodata.cst16 on x86_64, 16-byte aligned
+  | OtherSection String
+
+data CmmStatic
+  = CmmStaticLit CmmLit
+        -- a literal value, size given by cmmLitRep of the literal.
+  | CmmUninitialised Int
+        -- uninitialised data, N bytes long
+  | CmmString [Word8]
+        -- string of 8-bit values only, not zero terminated.
+
+data CmmStatics
+   = Statics
+       CLabel      -- Label of statics
+       [CmmStatic] -- The static data itself
+
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index e74e502727..baf4f8dac3 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -11,11 +11,16 @@ module CmmBuildInfoTables
     , TopSRT, emptySRT, srtToData
     , bundleCAFs
     , lowerSafeForeignCalls
-    , cafTransfers, liveSlotTransfers)
+    , cafTransfers, liveSlotTransfers
+    , mkLiveness )
 where
 
 #include "HsVersions.h"
 
+-- These should not be imported here!
+import StgCmmForeign
+import StgCmmUtils
+
 import Constants
 import Digraph
 import qualified Prelude as P
@@ -26,8 +31,7 @@ import BlockId
 import Bitmap
 import CLabel
 import Cmm
-import CmmDecl
-import CmmExpr
+import CmmUtils
 import CmmStackLayout
 import Module
 import FastString
@@ -41,9 +45,6 @@ import Name
 import OptimizationFuel
 import Outputable
 import SMRep
-import StgCmmClosure
-import StgCmmForeign
-import StgCmmUtils
 import UniqSupply
 
 import Compiler.Hoopl
@@ -87,13 +88,14 @@ type RegSlotInfo
      , LocalReg   -- The register
      , Int)       -- Width of the register
 
-live_ptrs :: ByteOff -> BlockEnv SubAreaSet -> AreaMap -> BlockId -> [Maybe LocalReg]
+live_ptrs :: ByteOff -> BlockEnv SubAreaSet -> AreaMap -> BlockId -> StackLayout
 live_ptrs oldByte slotEnv areaMap bid =
   -- pprTrace "live_ptrs for" (ppr bid <+> text (show oldByte ++ "-" ++ show youngByte) <+>
   --                           ppr liveSlots) $
   -- pprTrace ("stack layout for " ++ show bid ++ ": ") (ppr res) $ res
   res
-  where res = reverse $ slotsToList youngByte liveSlots []
+  where 
+        res = mkLiveness (reverse $ slotsToList youngByte liveSlots [])
  
         slotsToList :: Int -> [RegSlotInfo] -> [Maybe LocalReg] -> [Maybe LocalReg]
         -- n starts at youngByte and is decremented down to oldByte
@@ -160,8 +162,9 @@ live_ptrs oldByte slotEnv areaMap bid =
 -- is not the successor of a call.
 setInfoTableStackMap :: SlotEnv -> AreaMap -> CmmTop -> CmmTop
 setInfoTableStackMap slotEnv areaMap
-     t@(CmmProc (TopInfo {stack_info=StackInfo {updfr_space = Just updfr_off}}) _ (CmmGraph {g_entry = eid})) =
-  updInfo (const (live_ptrs updfr_off slotEnv areaMap eid)) id t
+     t@(CmmProc (TopInfo {stack_info=StackInfo {updfr_space = Just updfr_off}}) _ 
+                (CmmGraph {g_entry = eid}))
+  = updInfo (const (live_ptrs updfr_off slotEnv areaMap eid)) id t
 setInfoTableStackMap _ _ t = t
                  
 
@@ -237,8 +240,8 @@ addCAF caf srt =
       , elt_map  = Map.insert caf last (elt_map srt) }
     where last  = next_elt srt
 
-srtToData :: TopSRT -> Cmm
-srtToData srt = Cmm [CmmData RelocatableReadOnlyData (Statics (lbl srt) tbl)]
+srtToData :: TopSRT -> CmmPgm
+srtToData srt = [CmmData RelocatableReadOnlyData (Statics (lbl srt) tbl)]
     where tbl = map (CmmStaticLit . CmmLabel) (reverse (rev_elts srt))
 
 -- Once we have found the CAFs, we need to do two things:
@@ -336,9 +339,10 @@ localCAFInfo :: CAFEnv -> CmmTop -> Maybe (CLabel, CAFSet)
 localCAFInfo _      (CmmData _ _) = Nothing
 localCAFInfo cafEnv (CmmProc top_info top_l (CmmGraph {g_entry=entry})) =
   case info_tbl top_info of
-    CmmInfoTable _ False _ _ _ ->
-      Just (cvtToClosureLbl top_l,
-            expectJust "maybeBindCAFs" $ mapLookup entry cafEnv)
+    CmmInfoTable { cit_rep = rep } 
+      | not (isStaticRep rep) 
+      -> Just (cvtToClosureLbl top_l,
+               expectJust "maybeBindCAFs" $ mapLookup entry cafEnv)
     _ -> Nothing
 
 -- Once we have the local CAF sets for some (possibly) mutually
@@ -368,8 +372,6 @@ mkTopCAFInfo localCAFs = foldl addToTop Map.empty g
         g = stronglyConnCompFromEdgedVertices
               (map (\n@(l, cafs) -> (n, l, Map.keys cafs)) localCAFs)
 
-type StackLayout = [Maybe LocalReg]
-
 -- Bundle the CAFs used at a procpoint.
 bundleCAFs :: CAFEnv -> CmmTop -> (CAFSet, CmmTop)
 bundleCAFs cafEnv t@(CmmProc _ _ (CmmGraph {g_entry=entry})) =
@@ -391,20 +393,19 @@ setSRT cafs topCAFMap topSRT t =
        Just tbl -> return (topSRT, [t', tbl])
        Nothing  -> return (topSRT, [t'])
 
+type StackLayout = Liveness
+
 updInfo :: (StackLayout -> StackLayout) -> (C_SRT -> C_SRT) -> CmmTop -> CmmTop
 updInfo toVars toSrt (CmmProc top_info top_l g) =
   CmmProc (top_info {info_tbl=updInfoTbl toVars toSrt (info_tbl top_info)}) top_l g
 updInfo _ _ t = t
 
 updInfoTbl :: (StackLayout -> StackLayout) -> (C_SRT -> C_SRT) -> CmmInfoTable -> CmmInfoTable
-updInfoTbl toVars toSrt (CmmInfoTable l s p t typeinfo)
-  = CmmInfoTable l s p t typeinfo'
-    where typeinfo' = case typeinfo of
-            t@(ConstrInfo _ _ _)    -> t
-            (FunInfo    c s a d e)  -> FunInfo c (toSrt s) a d e
-            (ThunkInfo  c s)        -> ThunkInfo c (toSrt s)
-            (ThunkSelectorInfo x s) -> ThunkSelectorInfo x (toSrt s)
-            (ContInfo v s)          -> ContInfo (toVars v) (toSrt s)
+updInfoTbl toVars toSrt info_tbl@(CmmInfoTable {})
+  = info_tbl { cit_srt = toSrt (cit_srt info_tbl)
+             , cit_rep = case cit_rep info_tbl of
+                           StackRep ls -> StackRep (toVars ls)
+                           other       -> other }
 updInfoTbl _ _ t@CmmNonInfoTable = t
   
 ----------------------------------------------------------------
@@ -493,3 +494,4 @@ lowerSafeForeignCall entry areaMap blocks bid m
                                            resume  <**> saveRetVals <**> M.mkLast jump
     return $ blocks `mapUnion` toBlockMap graph'
 lowerSafeForeignCall _ _ _ _ _ _ = panic "lowerSafeForeignCall was passed something else"
+
diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs
index c0761fce6a..af60815c6e 100644
--- a/compiler/cmm/CmmCommonBlockElim.hs
+++ b/compiler/cmm/CmmCommonBlockElim.hs
@@ -11,7 +11,7 @@ where
 
 import BlockId
 import Cmm
-import CmmExpr
+import CmmUtils
 import Prelude hiding (iterate, succ, unzip, zip)
 
 import Compiler.Hoopl
diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs
index 42fc239e28..a04b3a43e1 100644
--- a/compiler/cmm/CmmContFlowOpt.hs
+++ b/compiler/cmm/CmmContFlowOpt.hs
@@ -10,8 +10,7 @@ where
 
 import BlockId
 import Cmm
-import CmmDecl
-import CmmExpr
+import CmmUtils
 import qualified OldCmm as Old
 
 import Maybes
@@ -22,7 +21,7 @@ import Prelude hiding (succ, unzip, zip)
 import Util
 
 ------------------------------------
-runCmmContFlowOpts :: Cmm -> Cmm
+runCmmContFlowOpts :: CmmPgm -> CmmPgm
 runCmmContFlowOpts prog = runCmmOpts cmmCfgOpts prog
 
 oldCmmCfgOpts :: Old.ListGraph Old.CmmStmt -> Old.ListGraph Old.CmmStmt
@@ -34,18 +33,14 @@ cmmCfgOpts    =
         -- Here branchChainElim can ultimately be replaced
         -- with a more exciting combination of optimisations
 
-runCmmOpts :: (g -> g) -> GenCmm d h g -> GenCmm d h g
+runCmmOpts :: (g -> g) -> GenCmmPgm d h g -> GenCmmPgm d h g
 -- Lifts a transformer on a single graph to one on the whole program
-runCmmOpts opt = mapProcs (optProc opt)
+runCmmOpts opt = map (optProc opt)
 
 optProc :: (g -> g) -> GenCmmTop d h g -> GenCmmTop d h g
 optProc _   top@(CmmData {}) = top
 optProc opt (CmmProc info lbl g) = CmmProc info lbl (opt g)
 
-------------------------------------
-mapProcs :: (GenCmmTop d h s -> GenCmmTop d h s) -> GenCmm d h s -> GenCmm d h s
-mapProcs f (Cmm tops) = Cmm (map f tops)
-
 ----------------------------------------------------------------
 oldBranchChainElim :: Old.ListGraph Old.CmmStmt -> Old.ListGraph Old.CmmStmt
 -- If L is not captured in an instruction, we can remove any
diff --git a/compiler/cmm/CmmCvt.hs b/compiler/cmm/CmmCvt.hs
index fcb220d74c..c0f715d211 100644
--- a/compiler/cmm/CmmCvt.hs
+++ b/compiler/cmm/CmmCvt.hs
@@ -3,91 +3,25 @@
 {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
 
 module CmmCvt
-  ( cmmToZgraph, cmmOfZgraph )
+  ( cmmOfZgraph )
 where
 
 import BlockId
 import Cmm
-import CmmDecl
-import CmmExpr
-import MkGraph
+import CmmUtils
 import qualified OldCmm as Old
 import OldPprCmm ()
-import Platform
 
 import Compiler.Hoopl hiding ((<*>), mkLabel, mkBranch)
-import Control.Monad
 import Data.Maybe
 import Maybes
 import Outputable
-import UniqSupply
 
-cmmToZgraph :: Platform -> Old.Cmm -> UniqSM Cmm
-cmmOfZgraph :: Cmm -> Old.Cmm
-
-cmmToZgraph platform (Cmm tops) = liftM Cmm $ mapM mapTop tops
-  where mapTop (CmmProc (Old.CmmInfo _ _ info_tbl) l g) =
-          do (stack_info, g) <- toZgraph platform (showSDoc $ ppr l) g
-             return $ CmmProc (TopInfo {info_tbl=info_tbl, stack_info=stack_info}) l g
-        mapTop (CmmData s ds) = return $ CmmData s ds
-cmmOfZgraph (Cmm tops) = Cmm $ map mapTop tops
+cmmOfZgraph :: CmmPgm -> Old.CmmPgm
+cmmOfZgraph tops = map mapTop tops
   where mapTop (CmmProc h l g) = CmmProc (Old.CmmInfo Nothing Nothing (info_tbl h)) l (ofZgraph g)
         mapTop (CmmData s ds) = CmmData s ds
 
-toZgraph :: Platform -> String -> Old.ListGraph Old.CmmStmt -> UniqSM (CmmStackInfo, CmmGraph)
-toZgraph _ _ (Old.ListGraph []) =
-  do g <- lgraphOfAGraph emptyAGraph
-     return (StackInfo {arg_space=0, updfr_space=Nothing}, g)
-toZgraph platform fun_name g@(Old.ListGraph (Old.BasicBlock id ss : other_blocks)) =
-           let (offset, entry) = mkCallEntry NativeNodeCall [] in
-           do g <- labelAGraph id $
-                     entry <*> mkStmts ss <*> foldr addBlock emptyAGraph other_blocks
-              return (StackInfo {arg_space = offset, updfr_space = Nothing}, g)
-  where addBlock (Old.BasicBlock id ss) g =
-          mkLabel id <*> mkStmts ss <*> g
-        updfr_sz = 0 -- panic "upd frame size lost in cmm conversion"
-        mkStmts (Old.CmmNop        : ss)  = mkNop        <*> mkStmts ss 
-        mkStmts (Old.CmmComment s  : ss)  = mkComment s  <*> mkStmts ss
-        mkStmts (Old.CmmAssign l r : ss)  = mkAssign l r <*> mkStmts ss
-        mkStmts (Old.CmmStore  l r : ss)  = mkStore  l r <*> mkStmts ss
-        mkStmts (Old.CmmCall (Old.CmmCallee f conv) res args (Old.CmmSafe _) Old.CmmMayReturn : ss) =
-            mkCall f (conv', conv') (map Old.hintlessCmm res) (map Old.hintlessCmm args) updfr_sz
-            <*> mkStmts ss
-              where conv' = Foreign (ForeignConvention conv [] []) -- JD: DUBIOUS
-        mkStmts (Old.CmmCall (Old.CmmPrim {}) _ _ (Old.CmmSafe _) _ : _) =
-            panic "safe call to a primitive CmmPrim CallishMachOp"
-        mkStmts (Old.CmmCall f res args Old.CmmUnsafe Old.CmmMayReturn : ss) =
-                      mkUnsafeCall (convert_target f res args)
-                        (strip_hints res) (strip_hints args)
-                      <*> mkStmts ss
-        mkStmts (Old.CmmCondBranch e l : fbranch) =
-            mkCmmIfThenElse e (mkBranch l) (mkStmts fbranch)
-        mkStmts (last : []) = mkLast last
-        mkStmts []          = bad "fell off end"
-        mkStmts (_ : _ : _) = bad "last node not at end"
-        bad msg = pprPanic (msg ++ " in function " ++ fun_name) (pprPlatform platform g)
-        mkLast (Old.CmmCall (Old.CmmCallee f conv) []     args _ Old.CmmNeverReturns) =
-            mkFinalCall f conv (map Old.hintlessCmm args) updfr_sz
-        mkLast (Old.CmmCall (Old.CmmPrim {}) _ _ _ Old.CmmNeverReturns) =
-            panic "Call to CmmPrim never returns?!"
-        mkLast (Old.CmmSwitch scrutinee table) = mkSwitch scrutinee table
-        -- SURELY, THESE HINTLESS ARGS ARE WRONG AND WILL BE FIXED WHEN CALLING
-        -- CONVENTIONS ARE HONORED?
-        mkLast (Old.CmmJump tgt args)          = mkJump   tgt (map Old.hintlessCmm args) updfr_sz
-        mkLast (Old.CmmReturn ress)            =
-          mkReturnSimple (map Old.hintlessCmm ress) updfr_sz
-        mkLast (Old.CmmBranch tgt)             = mkBranch tgt
-        mkLast (Old.CmmCall _f (_:_) _args _ Old.CmmNeverReturns) =
-                   panic "Call never returns but has results?!"
-        mkLast _ = panic "fell off end of block"
-
-strip_hints :: [Old.CmmHinted a] -> [a]
-strip_hints = map Old.hintlessCmm
-
-convert_target :: Old.CmmCallTarget -> [Old.HintedCmmFormal] -> [Old.HintedCmmActual] -> ForeignTarget
-convert_target (Old.CmmCallee e cc) ress  args  = ForeignTarget e (ForeignConvention cc (map Old.cmmHint args) (map Old.cmmHint ress))
-convert_target (Old.CmmPrim op)	   _ress _args = PrimTarget op
-
 data ValueDirection = Arguments | Results
 
 add_hints :: Convention -> ValueDirection -> [a] -> [Old.CmmHinted a]
diff --git a/compiler/cmm/CmmDecl.hs b/compiler/cmm/CmmDecl.hs
deleted file mode 100644
index 552878e7bb..0000000000
--- a/compiler/cmm/CmmDecl.hs
+++ /dev/null
@@ -1,139 +0,0 @@
------------------------------------------------------------------------------
---
--- Cmm data types
---
--- (c) The University of Glasgow 2004-2006
---
------------------------------------------------------------------------------
-
-module CmmDecl (
-        GenCmm(..), GenCmmTop(..),
-        CmmInfoTable(..), HasStaticClosure, ClosureTypeInfo(..), ConstrDescription,
-        ProfilingInfo(..), ClosureTypeTag,
-        CmmActual, CmmFormal, ForeignHint(..),
-        CmmStatics(..), CmmStatic(..), Section(..),
-  ) where
-
-#include "HsVersions.h"
-
-import CmmExpr
-import CLabel
-import SMRep
-import ClosureInfo
-
-import Data.Word
-
-
--- A [[BlockId]] is a local label.
--- Local labels must be unique within an entire compilation unit, not
--- just a single top-level item, because local labels map one-to-one
--- with assembly-language labels.
-
------------------------------------------------------------------------------
---  GenCmm, GenCmmTop
------------------------------------------------------------------------------
-
--- A file is a list of top-level chunks.  These may be arbitrarily
--- re-orderd during code generation.
-
--- GenCmm is abstracted over
---   d, the type of static data elements in CmmData
---   h, the static info preceding the code of a CmmProc
---   g, the control-flow graph of a CmmProc
---
--- We expect there to be two main instances of this type:
---   (a) C--, i.e. populated with various C-- constructs
---       (Cmm and RawCmm in OldCmm.hs)
---   (b) Native code, populated with data/instructions
---
--- A second family of instances based on Hoopl is in Cmm.hs.
---
-newtype GenCmm d h g = Cmm [GenCmmTop d h g]
-
--- | A top-level chunk, abstracted over the type of the contents of
--- the basic blocks (Cmm or instructions are the likely instantiations).
-data GenCmmTop d h g
-  = CmmProc     -- A procedure
-     h                 -- Extra header such as the info table
-     CLabel            -- Entry label
-     g                 -- Control-flow graph for the procedure's code
-
-  | CmmData     -- Static data
-        Section
-        d
-
-
------------------------------------------------------------------------------
---     Info Tables
------------------------------------------------------------------------------
-
--- Info table as a haskell data type
-data CmmInfoTable
-  = CmmInfoTable
-      CLabel -- Info table label
-      HasStaticClosure
-      ProfilingInfo
-      ClosureTypeTag -- Int
-      ClosureTypeInfo
-  | CmmNonInfoTable   -- Procedure doesn't need an info table
-
-type HasStaticClosure = Bool
-
--- TODO: The GC target shouldn't really be part of CmmInfo
--- as it doesn't appear in the resulting info table.
--- It should be factored out.
-
-data ClosureTypeInfo
-  = ConstrInfo ClosureLayout ConstrTag ConstrDescription
-  | FunInfo    ClosureLayout C_SRT FunArity ArgDescr SlowEntry
-  | ThunkInfo  ClosureLayout C_SRT
-  | ThunkSelectorInfo SelectorOffset C_SRT
-  | ContInfo
-      [Maybe LocalReg]  -- Stack layout: Just x, an item x
-                        --               Nothing: a 1-word gap
-                        -- Start of list is the *young* end
-      C_SRT
-
--- TODO: These types may need refinement
-data ProfilingInfo = ProfilingInfo CmmLit CmmLit -- closure_type, closure_desc
-type ClosureTypeTag = StgHalfWord
-type ClosureLayout = (StgHalfWord, StgHalfWord) -- ptrs, nptrs
-type ConstrTag = StgHalfWord
-type ConstrDescription = CmmLit
-type FunArity = StgHalfWord
-type SlowEntry = CmmLit
-  -- We would like this to be a CLabel but
-  -- for now the parser sets this to zero on an INFO_TABLE_FUN.
-type SelectorOffset = StgWord
-
-type CmmActual = CmmExpr
-type CmmFormal = LocalReg
-
-data ForeignHint
-  = NoHint | AddrHint | SignedHint
-  deriving( Eq )
-        -- Used to give extra per-argument or per-result
-        -- information needed by foreign calling conventions
-
------------------------------------------------------------------------------
---              Static Data
------------------------------------------------------------------------------
-
-data Section
-  = Text
-  | Data
-  | ReadOnlyData
-  | RelocatableReadOnlyData
-  | UninitialisedData
-  | ReadOnlyData16      -- .rodata.cst16 on x86_64, 16-byte aligned
-  | OtherSection String
-
-data CmmStatic
-  = CmmStaticLit CmmLit
-        -- a literal value, size given by cmmLitRep of the literal.
-  | CmmUninitialised Int
-        -- uninitialised data, N bytes long
-  | CmmString [Word8]
-        -- string of 8-bit values only, not zero terminated.
-
-data CmmStatics = Statics CLabel {- Label of statics -} [CmmStatic] {- The static data itself -}
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index e463b3619f..4e2d976826 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -6,39 +6,34 @@ module CmmInfo (
 
 #include "HsVersions.h"
 
-import OldCmm
-import CmmUtils
+import OldCmm as Old
 
+import CmmUtils
 import CLabel
-
-import Bitmap
-import ClosureInfo
-import CgInfoTbls
-import CgCallConv
-import CgUtils
 import SMRep
+import Bitmap
 
+import Maybes
 import Constants
 import Panic
 import StaticFlags
-import Unique
 import UniqSupply
-
+import MonadUtils
 import Data.Bits
+import Data.Word
 
 -- When we split at proc points, we need an empty info table.
 mkEmptyContInfoTable :: CLabel -> CmmInfoTable
-mkEmptyContInfoTable info_lbl = CmmInfoTable info_lbl False (ProfilingInfo zero zero) rET_SMALL
-                                             (ContInfo [] NoC_SRT)
-    where zero = CmmInt 0 wordWidth
-
-cmmToRawCmm :: [Cmm] -> IO [RawCmm]
-cmmToRawCmm cmm = do
-  info_tbl_uniques <- mkSplitUniqSupply 'i'
-  return $ zipWith raw_cmm (listSplitUniqSupply info_tbl_uniques) cmm
-    where
-      raw_cmm uniq_supply (Cmm procs) =
-          Cmm $ concat $ zipWith mkInfoTable (uniqsFromSupply uniq_supply) procs
+mkEmptyContInfoTable info_lbl 
+  = CmmInfoTable { cit_lbl  = info_lbl
+                 , cit_rep  = mkStackRep []
+                 , cit_prof = NoProfilingInfo
+                 , cit_srt  = NoC_SRT }
+
+cmmToRawCmm :: [Old.CmmPgm] -> IO [Old.RawCmmPgm]
+cmmToRawCmm cmms
+  = do { uniqs <- mkSplitUniqSupply 'i'
+       ; return (initUs_ uniqs (mapM (concatMapM mkInfoTable) cmms)) }
 
 -- Make a concrete info table, represented as a list of CmmStatic
 -- (it can't be simply a list of Word, because the SRT field is
@@ -73,105 +68,165 @@ cmmToRawCmm cmm = do
 --
 --  * The SRT slot is only there if there is SRT info to record
 
-mkInfoTable :: Unique -> CmmTop -> [RawCmmTop]
-mkInfoTable _    (CmmData sec dat) = [CmmData sec dat]
-mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label blocks) =
-    case info of
-      -- Code without an info table.  Easy.
-      CmmNonInfoTable -> [CmmProc Nothing entry_label blocks]
-
-      CmmInfoTable info_label _ (ProfilingInfo ty_prof cl_prof) type_tag type_info ->
-          let ty_prof'   = makeRelativeRefTo info_label ty_prof
-              cl_prof'   = makeRelativeRefTo info_label cl_prof
-          in case type_info of
-          -- A function entry point.
-          FunInfo (ptrs, nptrs) srt fun_arity pap_bitmap slow_entry ->
-              mkInfoTableAndCode info_label std_info fun_extra_bits entry_label
-                                 blocks
-            where
-              fun_type = argDescrType pap_bitmap
-              fun_extra_bits =
-                 [packHalfWordsCLit fun_type fun_arity] ++
-                 case pap_bitmap of
-                 ArgGen liveness ->
-                     (if null srt_label then [mkIntCLit 0] else srt_label) ++
-                     [makeRelativeRefTo info_label $ mkLivenessCLit liveness,
-                      makeRelativeRefTo info_label slow_entry]
-                 _ -> srt_label
-              std_info = mkStdInfoTable ty_prof' cl_prof' type_tag srt_bitmap
-                                        layout
-              (srt_label, srt_bitmap) = mkSRTLit info_label srt
-              layout = packHalfWordsCLit ptrs nptrs
-
-          -- A constructor.
-          ConstrInfo (ptrs, nptrs) con_tag descr ->
-              mkInfoTableAndCode info_label std_info [con_name] entry_label
-                                 blocks
-              where
-                std_info = mkStdInfoTable ty_prof' cl_prof' type_tag con_tag layout
-                con_name = makeRelativeRefTo info_label descr
-                layout = packHalfWordsCLit ptrs nptrs
-          -- A thunk.
-          ThunkInfo (ptrs, nptrs) srt ->
-              mkInfoTableAndCode info_label std_info srt_label entry_label
-                                 blocks
-              where
-                std_info = mkStdInfoTable ty_prof' cl_prof' type_tag srt_bitmap layout
-                (srt_label, srt_bitmap) = mkSRTLit info_label srt
-                layout = packHalfWordsCLit ptrs nptrs
-
-          -- A selector thunk.
-          ThunkSelectorInfo offset _srt ->
-              mkInfoTableAndCode info_label std_info [{- no SRT -}] entry_label
-                                 blocks
-              where
-                std_info = mkStdInfoTable ty_prof' cl_prof' type_tag 0 (mkWordCLit offset)
-
-          -- A continuation/return-point.
-          ContInfo stack_layout srt ->
-              liveness_data ++
-              mkInfoTableAndCode info_label std_info srt_label entry_label
-                                 blocks
-              where
-                std_info = mkStdInfoTable ty_prof' cl_prof' maybe_big_type_tag srt_bitmap
-                                          (makeRelativeRefTo info_label liveness_lit)
-                (liveness_lit, liveness_data, liveness_tag) =
-                    mkLiveness uniq stack_layout
-                maybe_big_type_tag = if type_tag == rET_SMALL
-                                     then liveness_tag
-                                     else type_tag
-                (srt_label, srt_bitmap) = mkSRTLit info_label srt
-
--- Handle the differences between tables-next-to-code
--- and not tables-next-to-code
-mkInfoTableAndCode :: CLabel
-                   -> [CmmLit]
-                   -> [CmmLit]
-                   -> CLabel
-                   -> ListGraph CmmStmt
+mkInfoTable :: CmmTop -> UniqSM [RawCmmTop]
+mkInfoTable (CmmData sec dat) 
+  = return [CmmData sec dat]
+
+mkInfoTable (CmmProc (CmmInfo _ _ info) entry_label blocks)
+  | CmmNonInfoTable <- info   -- Code without an info table.  Easy.
+  = return [CmmProc Nothing entry_label blocks]
+                               
+  | CmmInfoTable { cit_lbl = info_lbl } <- info
+  = do { (top_decls, info_cts) <- mkInfoTableContents info
+       ; return (top_decls  ++
+                 mkInfoTableAndCode info_lbl info_cts
+                                    entry_label blocks) }
+  | otherwise = panic "mkInfoTable"  -- Patern match overlap check not clever enough
+
+-----------------------------------------------------
+type InfoTableContents = ( [CmmLit]	     -- The standard part
+                         , [CmmLit] )	     -- The "extra bits"
+-- These Lits have *not* had mkRelativeTo applied to them
+
+mkInfoTableContents :: CmmInfoTable
+                    -> UniqSM ([RawCmmTop],		-- Auxiliary top decls
+                               InfoTableContents)	-- Info tbl + extra bits
+mkInfoTableContents (CmmInfoTable { cit_lbl  = info_lbl
+                                  , cit_rep  = smrep
+                                  , cit_prof = prof, cit_srt = srt }) 
+  | StackRep frame <- smrep
+  = do { (prof_lits,    prof_data)     <- mkProfLits prof
+       ; (liveness_lit, liveness_data) <- mkLivenessBits frame
+       ; let (extra_bits, srt_bitmap) = mkSRTLit srt
+             std_info = mkStdInfoTable prof_lits rts_tag srt_bitmap liveness_lit
+             rts_tag | null liveness_data = rET_SMALL  -- Fits in extra_bits
+                     | otherwise          = rET_BIG    -- Does not; extra_bits is
+                                                       -- a label
+       ; return (prof_data ++ liveness_data, (std_info, extra_bits)) }
+
+  | HeapRep _ ptrs nonptrs closure_type <- smrep
+  = do { let rts_tag = rtsClosureType smrep
+             layout  = packHalfWordsCLit ptrs nonptrs
+  	     (srt_label, srt_bitmap) = mkSRTLit srt
+
+       ; (prof_lits, prof_data) <- mkProfLits prof
+       ; (mb_srt_field, mb_layout, extra_bits, ct_data) 
+                                <- mk_pieces closure_type srt_label
+       ; let std_info = mkStdInfoTable prof_lits rts_tag 
+                                       (mb_srt_field `orElse` srt_bitmap)
+                                       (mb_layout    `orElse` layout)
+       ; return (prof_data ++ ct_data, (std_info, extra_bits)) }
+  where
+    mk_pieces :: ClosureTypeInfo -> [CmmLit]
+              -> UniqSM ( Maybe StgHalfWord  -- Override the SRT field with this
+                 	, Maybe CmmLit       -- Override the layout field with this
+                 	, [CmmLit]           -- "Extra bits" for info table
+                 	, [RawCmmTop])	     -- Auxiliary data decls 
+    mk_pieces (Constr con_tag con_descr) _no_srt    -- A data constructor
+      = do { (descr_lit, decl) <- newStringLit con_descr
+      	   ; return (Just con_tag, Nothing, [descr_lit], [decl]) }
+
+    mk_pieces Thunk srt_label
+      = return (Nothing, Nothing, srt_label, [])
+
+    mk_pieces (ThunkSelector offset) _no_srt
+      = return (Just 0, Just (mkWordCLit offset), [], [])
+         -- Layout known (one free var); we use the layout field for offset
+
+    mk_pieces (Fun arity (ArgSpec fun_type)) srt_label 
+      = do { let extra_bits = packHalfWordsCLit fun_type arity : srt_label
+           ; return (Nothing, Nothing,  extra_bits, []) }
+
+    mk_pieces (Fun arity (ArgGen arg_bits)) srt_label
+      = do { (liveness_lit, liveness_data) <- mkLivenessBits arg_bits
+           ; let fun_type | null liveness_data = aRG_GEN
+                          | otherwise          = aRG_GEN_BIG
+                 extra_bits = [ packHalfWordsCLit fun_type arity
+                              , srt_lit, liveness_lit, slow_entry ]
+           ; return (Nothing, Nothing, extra_bits, liveness_data) }
+      where
+        slow_entry = CmmLabel (slowEntryFromInfoLabel info_lbl)
+        srt_lit = case srt_label of
+                    []          -> mkIntCLit 0
+                    (lit:_rest) -> ASSERT( null _rest ) lit
+
+    mk_pieces BlackHole _ = panic "mk_pieces: BlackHole"
+
+mkInfoTableContents _ = panic "mkInfoTableContents"   -- NonInfoTable dealt with earlier
+
+mkSRTLit :: C_SRT
+         -> ([CmmLit],    -- srt_label, if any
+             StgHalfWord) -- srt_bitmap
+mkSRTLit NoC_SRT                = ([], 0)
+mkSRTLit (C_SRT lbl off bitmap) = ([cmmLabelOffW lbl off], bitmap)
+
+
+-------------------------------------------------------------------------
+--
+--      Lay out the info table and handle relative offsets
+--
+-------------------------------------------------------------------------
+
+-- This function takes
+--   * the standard info table portion (StgInfoTable)
+--   * the "extra bits" (StgFunInfoExtraRev etc.)
+--   * the entry label
+--   * the code
+-- and lays them out in memory, producing a list of RawCmmTop
+
+-- The value of tablesNextToCode determines the relative positioning
+-- of the extra bits and the standard info table, and whether the
+-- former is reversed or not.  It also decides whether pointers in the
+-- info table should be expressed as offsets relative to the info
+-- pointer or not (see "Position Independent Code" below.
+
+mkInfoTableAndCode :: CLabel             -- Info table label
+                   -> InfoTableContents
+                   -> CLabel     	 -- Entry label
+                   -> ListGraph CmmStmt  -- Entry code
                    -> [RawCmmTop]
-mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl blocks
+mkInfoTableAndCode info_lbl (std_info, extra_bits) entry_lbl blocks
   | tablesNextToCode 	-- Reverse the extra_bits; and emit the top-level proc
-  = [CmmProc (Just (Statics info_lbl $ map CmmStaticLit (reverse extra_bits ++ std_info)))
+  = [CmmProc (Just $ Statics info_lbl $ map CmmStaticLit $
+                     reverse rel_extra_bits ++ rel_std_info)
              entry_lbl blocks]
 
   | ListGraph [] <- blocks -- No code; only the info table is significant
   =		-- Use a zero place-holder in place of the 
 		-- entry-label in the info table
-    [mkRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)]
+    [mkRODataLits info_lbl (zeroCLit : rel_std_info ++ rel_extra_bits)]
 
   | otherwise	-- Separately emit info table (with the function entry 
   =		-- point as first entry) and the entry code 
     [CmmProc Nothing entry_lbl blocks,
-     mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)]
+     mkDataLits Data info_lbl (CmmLabel entry_lbl : rel_std_info ++ rel_extra_bits)]
+  where
+    rel_std_info   = map (makeRelativeRefTo info_lbl) std_info
+    rel_extra_bits = map (makeRelativeRefTo info_lbl) extra_bits
+
+-------------------------------------------------------------------------
+--
+--	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
 
-mkSRTLit :: CLabel
-         -> C_SRT
-         -> ([CmmLit],    -- srt_label
-             StgHalfWord) -- srt_bitmap
-mkSRTLit _          NoC_SRT = ([], 0)
-mkSRTLit info_label (C_SRT lbl off bitmap) =
-    ([makeRelativeRefTo info_label (cmmLabelOffW lbl off)], bitmap)
 
 -------------------------------------------------------------------------
 --
@@ -193,50 +248,36 @@ mkSRTLit info_label (C_SRT lbl off bitmap) =
 -- The head of the stack layout is the top of the stack and
 -- the least-significant bit.
 
--- TODO: refactor to use utility functions
--- TODO: combine with CgCallConv.mkLiveness (see comment there)
-mkLiveness :: Unique
-           -> [Maybe LocalReg]
-           -> (CmmLit, [RawCmmTop], ClosureTypeTag)
+mkLivenessBits :: Liveness -> UniqSM (CmmLit, [RawCmmTop])
               -- ^ Returns:
               --   1. The bitmap (literal value or label)
               --   2. Large bitmap CmmData if needed
-              --   3. rET_SMALL or rET_BIG
-mkLiveness uniq live =
-  if length bits > mAX_SMALL_BITMAP_SIZE
-    -- does not fit in one word
-    then (CmmLabel big_liveness, [data_lits], rET_BIG)
-    -- fits in one word
-    else (mkWordCLit  small_liveness, [], rET_SMALL)
-  where
-    mkBits [] = []
-    mkBits (reg:regs) = take sizeW bits ++ mkBits regs where
-        sizeW = case reg of
-                  Nothing -> 1
-                  Just r -> (widthInBytes (typeWidth (localRegType r)) + wORD_SIZE - 1)
-                            `quot` wORD_SIZE
-                            -- number of words, rounded up
-        bits = repeat $ is_non_ptr reg -- True <=> Non Ptr
 
-    is_non_ptr Nothing    = True
-    is_non_ptr (Just reg) = not $ isGcPtrType (localRegType reg)
+mkLivenessBits liveness
+  | n_bits > mAX_SMALL_BITMAP_SIZE    -- does not fit in one word
+  = do { uniq <- getUniqueUs
+       ; let bitmap_lbl = mkBitmapLabel uniq
+       ; return (CmmLabel bitmap_lbl, 
+                 [mkRODataLits bitmap_lbl lits]) }
 
-    bits :: [Bool]
-    bits = mkBits live
+  | otherwise -- Fits in one word
+  = return (mkWordCLit bitmap_word, [])
+  where
+    n_bits = length liveness
 
     bitmap :: Bitmap
-    bitmap = mkBitmap bits
+    bitmap = mkBitmap liveness
 
     small_bitmap = case bitmap of 
-		   []  -> 0
-                   [b] -> b
-		   _   -> panic "mkLiveness"
-    small_liveness =
-        fromIntegral (length bits) .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT)
+		     []  -> 0
+                     [b] -> b
+		     _   -> panic "mkLiveness"
+    bitmap_word = fromIntegral n_bits
+              .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT)
 
-    big_liveness = mkBitmapLabel uniq
-    lits = mkWordCLit (fromIntegral (length bits)) : map mkWordCLit bitmap
-    data_lits = mkRODataLits big_liveness lits
+    lits = mkWordCLit (fromIntegral n_bits) : map mkWordCLit bitmap
+      -- The first word is the size.  The structure must match
+      -- StgLargeBitmap in includes/rts/storage/InfoTable.h
 
 -------------------------------------------------------------------------
 --
@@ -245,20 +286,20 @@ mkLiveness uniq live =
 -------------------------------------------------------------------------
 
 -- The standard bits of an info table.  This part of the info table
--- corresponds to the StgInfoTable type defined in InfoTables.h.
+-- corresponds to the StgInfoTable type defined in
+-- includes/rts/storage/InfoTables.h.
 --
 -- Its shape varies with ticky/profiling/tables next to code etc
 -- so we can't use constant offsets from Constants
 
 mkStdInfoTable
-   :: CmmLit		-- closure type descr (profiling)
-   -> CmmLit		-- closure descr (profiling)
-   -> StgHalfWord	-- closure type
+   :: (CmmLit,CmmLit)	-- Closure type descr and closure descr  (profiling)
+   -> StgHalfWord	-- Closure RTS tag 
    -> StgHalfWord	-- SRT length
    -> CmmLit		-- layout field
    -> [CmmLit]
 
-mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
+mkStdInfoTable (type_descr, closure_descr) cl_type srt_len layout_lit
  = 	-- Parallel revertible-black hole field
     prof_info
 	-- Ticky info (none at present)
@@ -272,3 +313,21 @@ mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
 
     type_lit = packHalfWordsCLit cl_type srt_len
 
+-------------------------------------------------------------------------
+--
+--      Making string literals
+--
+-------------------------------------------------------------------------
+
+mkProfLits :: ProfilingInfo -> UniqSM ((CmmLit,CmmLit), [RawCmmTop])
+mkProfLits NoProfilingInfo       = return ((zeroCLit, zeroCLit), [])
+mkProfLits (ProfilingInfo td cd)
+  = do { (td_lit, td_decl) <- newStringLit td
+       ; (cd_lit, cd_decl) <- newStringLit cd
+       ; return ((td_lit,cd_lit), [td_decl,cd_decl]) }
+
+newStringLit :: [Word8] -> UniqSM (CmmLit, GenCmmTop CmmStatics info stmt)
+newStringLit bytes
+  = do { uniq <- getUniqueUs
+       ; return (mkByteStringCLit uniq bytes) }
+
diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs
index 15357ecb94..dd47c4433e 100644
--- a/compiler/cmm/CmmLint.hs
+++ b/compiler/cmm/CmmLint.hs
@@ -31,8 +31,8 @@ import Data.Maybe
 -- Exported entry points:
 
 cmmLint :: (Outputable d, Outputable h)
-        => Platform -> GenCmm d h (ListGraph CmmStmt) -> Maybe SDoc
-cmmLint platform (Cmm tops) = runCmmLint platform (mapM_ lintCmmTop) tops
+        => Platform -> GenCmmPgm d h (ListGraph CmmStmt) -> Maybe SDoc
+cmmLint platform tops = runCmmLint platform (mapM_ lintCmmTop) tops
 
 cmmLintTop :: (Outputable d, Outputable h)
            => Platform -> GenCmmTop d h (ListGraph CmmStmt) -> Maybe SDoc
diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs
index ca3ab095ed..9a5bb2d5ae 100644
--- a/compiler/cmm/CmmLive.hs
+++ b/compiler/cmm/CmmLive.hs
@@ -13,7 +13,7 @@ where
 
 import BlockId
 import Cmm
-import CmmExpr
+import CmmUtils
 import Control.Monad
 import OptimizationFuel
 import PprCmmExpr ()
diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs
index f5a88cebb8..e9b84b568a 100644
--- a/compiler/cmm/CmmNode.hs
+++ b/compiler/cmm/CmmNode.hs
@@ -7,16 +7,14 @@
 {-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
 #endif
 
-module CmmNode
-  ( CmmNode(..)
-  , UpdFrameOffset, Convention(..), ForeignConvention(..), ForeignTarget(..)
-  , mapExp, mapExpDeep, wrapRecExp, foldExp, foldExpDeep, wrapRecExpf
-  , mapExpM, mapExpDeepM, wrapRecExpM
-  )
-where
+module CmmNode (
+     CmmNode(..), ForeignHint(..), CmmFormal, CmmActual,
+     UpdFrameOffset, Convention(..), ForeignConvention(..), ForeignTarget(..),
+     mapExp, mapExpDeep, wrapRecExp, foldExp, foldExpDeep, wrapRecExpf,
+     mapExpM, mapExpDeepM, wrapRecExpM
+  ) where
 
 import CmmExpr
-import CmmDecl
 import FastString
 import ForeignCall
 import SMRep
@@ -200,6 +198,9 @@ instance HooplNode CmmNode where
 --------------------------------------------------
 -- Various helper types
 
+type CmmActual = CmmExpr
+type CmmFormal = LocalReg
+
 type UpdFrameOffset = ByteOff
 
 data Convention
@@ -235,6 +236,12 @@ data ForeignTarget        -- The target of a foreign call
         CallishMachOp            -- Which one
   deriving Eq
 
+data ForeignHint
+  = NoHint | AddrHint | SignedHint
+  deriving( Eq )
+        -- Used to give extra per-argument or per-result
+        -- information needed by foreign calling conventions
+
 --------------------------------------------------
 -- Instances of register and slot users / definers
 
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 9d9136e18b..cd0c021db6 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -191,7 +191,7 @@ cmmdata :: { ExtCode }
 	: 'section' STRING '{' data_label statics '}' 
 		{ do lbl <- $4;
 		     ss <- sequence $5;
-		     code (emitData (section $2) (Statics lbl $ concat ss)) }
+		     code (emitDecl (CmmData (section $2) (Statics lbl $ concat ss))) }
 
 data_label :: { ExtFCode CLabel }
     : NAME ':'	
@@ -264,23 +264,28 @@ info	:: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
 	: 'INFO_TABLE' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
 		-- ptrs, nptrs, closure type, description, type
 		{% withThisPackage $ \pkg ->
-		   do prof <- profilingInfo $11 $13
+		   do let prof = profilingInfo $11 $13
+			  rep = mkHeapRep False (fromIntegral $5) (fromIntegral $7) Thunk
+			-- ToDo: Type tag $9 redundant
 		      return (mkCmmEntryLabel pkg $3,
-			CmmInfoTable (mkCmmInfoLabel pkg $3) False prof (fromIntegral $9)
-				     (ThunkInfo (fromIntegral $5, fromIntegral $7) NoC_SRT),
-			[]) }
+			      CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
+				           , cit_rep = rep
+               				   , cit_prof = prof, cit_srt = NoC_SRT },
+			      []) }
 	
 	| 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')'
 		-- ptrs, nptrs, closure type, description, type, fun type
 		{% withThisPackage $ \pkg -> 
-		   do prof <- profilingInfo $11 $13
+		   do let prof = profilingInfo $11 $13
+			  rep = mkHeapRep False (fromIntegral $5) (fromIntegral $7) ty
+                          ty  = Fun 0  -- Arity zero
+				     (ArgSpec (fromIntegral $15))
+			-- ToDo: Type tag $9 redundant
 		      return (mkCmmEntryLabel pkg $3,
-			CmmInfoTable (mkCmmInfoLabel pkg $3) False prof (fromIntegral $9)
-				     (FunInfo (fromIntegral $5, fromIntegral $7) NoC_SRT
-				      0  -- Arity zero
-				      (ArgSpec (fromIntegral $15))
-				      zeroCLit),
-			[]) }
+			      CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
+				           , cit_rep = rep
+               				   , cit_prof = prof, cit_srt = NoC_SRT },
+			      []) }
 		-- we leave most of the fields zero here.  This is only used
 		-- to generate the BCO info table in the RTS at the moment.
 
@@ -288,54 +293,73 @@ info	:: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
 	| 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ',' INT ')'
 		-- ptrs, nptrs, closure type, description, type, fun type, arity
 		{% withThisPackage $ \pkg ->
-		   do prof <- profilingInfo $11 $13
+		   do let prof = profilingInfo $11 $13
+			  rep = mkHeapRep False (fromIntegral $5) (fromIntegral $7) ty
+			  ty  = Fun (fromIntegral $17)  -- Arity 
+				     (ArgSpec (fromIntegral $15))
+			-- ToDo: Type tag $9 redundant
 		      return (mkCmmEntryLabel pkg $3,
-			CmmInfoTable (mkCmmInfoLabel pkg $3) False prof (fromIntegral $9)
-				     (FunInfo (fromIntegral $5, fromIntegral $7) NoC_SRT (fromIntegral $17)
-				      (ArgSpec (fromIntegral $15))
-				      zeroCLit),
-			[]) }
+			      CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
+				           , cit_rep = rep
+               				   , cit_prof = prof, cit_srt = NoC_SRT },
+			      []) }
 		-- we leave most of the fields zero here.  This is only used
 		-- to generate the BCO info table in the RTS at the moment.
 	
 	| 'INFO_TABLE_CONSTR' '(' NAME ',' INT ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
 		-- ptrs, nptrs, tag, closure type, description, type
 		{% withThisPackage $ \pkg ->
-		   do prof <- profilingInfo $13 $15
+		   do let prof = profilingInfo $13 $15
+			  rep = mkHeapRep False (fromIntegral $5) (fromIntegral $7) ty
+			  ty  = Constr (fromIntegral $9)  -- Tag
+	                           	(stringToWord8s $13)
+			-- ToDo: Type tag $11 redundant
+		      return (mkCmmEntryLabel pkg $3,
+			      CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
+				           , cit_rep = rep
+               				   , cit_prof = prof, cit_srt = NoC_SRT },
+			      []) }
+
 		     -- If profiling is on, this string gets duplicated,
 		     -- but that's the way the old code did it we can fix it some other time.
-		      desc_lit <- code $ mkStringCLit $13
-		      return (mkCmmEntryLabel pkg $3,
-			CmmInfoTable (mkCmmInfoLabel pkg $3) False prof (fromIntegral $11)
-				     (ConstrInfo (fromIntegral $5, fromIntegral $7) (fromIntegral $9) desc_lit),
-			[]) }
 	
 	| 'INFO_TABLE_SELECTOR' '(' NAME ',' INT ',' INT ',' STRING ',' STRING ')'
 		-- selector, closure type, description, type
 		{% withThisPackage $ \pkg ->
-		   do prof <- profilingInfo $9 $11
+		   do let prof = profilingInfo $9 $11
+			  rep = mkHeapRep False (fromIntegral $5) (fromIntegral $7) ty
+                          ty  = ThunkSelector (fromIntegral $5)
+			-- ToDo: Type tag $7 redundant
 		      return (mkCmmEntryLabel pkg $3,
-			CmmInfoTable (mkCmmInfoLabel pkg $3) False prof (fromIntegral $7)
-				     (ThunkSelectorInfo (fromIntegral $5) NoC_SRT),
-			[]) }
+			      CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
+				           , cit_rep = rep
+               				   , cit_prof = prof, cit_srt = NoC_SRT },
+			      []) }
 
 	| 'INFO_TABLE_RET' '(' NAME ',' INT ')'
 		-- closure type (no live regs)
 		{% withThisPackage $ \pkg ->
-		   do let infoLabel = mkCmmInfoLabel pkg $3
+		   do let prof = NoProfilingInfo
+			  rep  = mkStackRep []
+			-- ToDo: Type tag $5 redundant
 		      return (mkCmmRetLabel pkg $3,
-			CmmInfoTable (mkCmmInfoLabel pkg $3) False (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
-				     (ContInfo [] NoC_SRT),
-			[]) }
+			      CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
+				           , cit_rep = rep
+               				   , cit_prof = prof, cit_srt = NoC_SRT },
+			      []) }
 
 	| 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals_without_hints0 ')'
 		-- closure type, live regs
 		{% withThisPackage $ \pkg ->
 		   do live <- sequence (map (liftM Just) $7)
+		      let prof = NoProfilingInfo
+			  rep  = mkStackRep []
+			-- ToDo: Type tag $5 redundant
 		      return (mkCmmRetLabel pkg $3,
-			CmmInfoTable (mkCmmInfoLabel pkg $3) False (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
-			             (ContInfo live NoC_SRT),
-			live) }
+			      CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
+				           , cit_rep = rep
+               				   , cit_prof = prof, cit_srt = NoC_SRT },
+			      []) }
 
 body	:: { ExtCode }
 	: {- empty -}			{ return () }
@@ -499,7 +523,7 @@ expr	:: { ExtFCode CmmExpr }
 expr0	:: { ExtFCode CmmExpr }
 	: INT   maybe_ty	 { return (CmmLit (CmmInt $1 (typeWidth $2))) }
 	| FLOAT maybe_ty	 { return (CmmLit (CmmFloat $1 (typeWidth $2))) }
-	| STRING		 { do s <- code (mkStringCLit $1); 
+	| STRING		 { do s <- code (newStringCLit $1); 
 				      return (CmmLit s) }
 	| reg			 { $1 }
 	| type '[' expr ']'	 { do e <- $3; return (CmmLoad e $1) }
@@ -828,16 +852,10 @@ stmtMacros = listToUFM [
  ]
 
 
-
-profilingInfo desc_str ty_str = do
-  lit1 <- if opt_SccProfilingOn 
-		   then code $ mkStringCLit desc_str
-		   else return (mkIntCLit 0)
-  lit2 <- if opt_SccProfilingOn 
-		   then code $ mkStringCLit ty_str
-		   else return (mkIntCLit 0)
-  return (ProfilingInfo lit1 lit2)
-
+profilingInfo desc_str ty_str 
+  | not opt_SccProfilingOn = NoProfilingInfo
+  | otherwise              = ProfilingInfo (stringToWord8s desc_str)
+                                           (stringToWord8s ty_str)
 
 staticClosure :: PackageId -> FastString -> FastString -> [CmmLit] -> ExtCode
 staticClosure pkg cl_label info payload
@@ -1051,12 +1069,12 @@ doSwitch mb_range scrut arms deflt
 initEnv :: Env
 initEnv = listToUFM [
   ( fsLit "SIZEOF_StgHeader", 
-    Var (CmmLit (CmmInt (fromIntegral (fixedHdrSize * wORD_SIZE)) wordWidth) )),
+    VarN (CmmLit (CmmInt (fromIntegral (fixedHdrSize * wORD_SIZE)) wordWidth) )),
   ( fsLit "SIZEOF_StgInfoTable",
-    Var (CmmLit (CmmInt (fromIntegral stdInfoTableSizeB) wordWidth) ))
+    VarN (CmmLit (CmmInt (fromIntegral stdInfoTableSizeB) wordWidth) ))
   ]
 
-parseCmmFile :: DynFlags -> FilePath -> IO (Messages, Maybe Cmm)
+parseCmmFile :: DynFlags -> FilePath -> IO (Messages, Maybe CmmPgm)
 parseCmmFile dflags filename = do
   showPass dflags "ParseCmm"
   buf <- hGetStringBuffer filename
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs
index 5effa6ca77..8c6e0a765f 100644
--- a/compiler/cmm/CmmPipeline.hs
+++ b/compiler/cmm/CmmPipeline.hs
@@ -11,7 +11,6 @@ module CmmPipeline (
 
 import CLabel
 import Cmm
-import CmmDecl
 import CmmLive
 import CmmBuildInfoTables
 import CmmCommonBlockElim
@@ -54,21 +53,31 @@ import StaticFlags
 --    we actually need to do the initial pass.
 cmmPipeline  :: HscEnv -- Compilation env including
                        -- dynamic flags: -dcmm-lint -ddump-cps-cmm
-             -> (TopSRT, [Cmm])    -- SRT table and accumulating list of compiled procs
-             -> Cmm                -- Input C-- with Procedures
-             -> IO (TopSRT, [Cmm]) -- Output CPS transformed C--
+             -> (TopSRT, [CmmPgm])    -- SRT table and accumulating list of compiled procs
+             -> CmmPgm             -- Input C-- with Procedures
+             -> IO (TopSRT, [CmmPgm]) -- Output CPS transformed C--
 cmmPipeline hsc_env (topSRT, rst) prog =
   do let dflags = hsc_dflags hsc_env
-         (Cmm tops) = runCmmContFlowOpts prog
+     --
      showPass dflags "CPSZ"
+
+     let tops = runCmmContFlowOpts prog
      (cafEnvs, tops) <- liftM unzip $ mapM (cpsTop hsc_env) tops
+     -- tops :: [[(CmmTop,CAFSet]]  (one list per group)
+
      let topCAFEnv = mkTopCAFInfo (concat cafEnvs)
+
+     -- folding over the groups
      (topSRT, tops) <- foldM (toTops hsc_env topCAFEnv) (topSRT, []) tops
-     let cmms = Cmm (reverse (concat tops))
+
+     let cmms = reverse (concat tops)
+
      dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (pprPlatform (targetPlatform dflags) cmms)
+
      -- SRT is not affected by control flow optimization pass
-     let prog' = map runCmmContFlowOpts (cmms : rst)
-     return (topSRT, prog')
+     let prog' = runCmmContFlowOpts cmms
+
+     return (topSRT, prog' : rst)
 
 {- [Note global fuel]
 ~~~~~~~~~~~~~~~~~~~~~
@@ -152,6 +161,10 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
        gs <- return $ map (bundleCAFs cafEnv) gs
        mapM_ (dumpPlatform platform Opt_D_dump_cmmz_cafs "after bundleCAFs") gs
        return (localCAFs, gs)
+
+              -- gs        :: [ (CAFSet, CmmTop) ]
+              -- localCAFs :: [ (CLabel, CAFSet) ] -- statics filtered out(?)
+
   where dflags = hsc_dflags hsc_env
         platform = targetPlatform dflags
         mbpprTrace x y z = if dopt Opt_D_dump_cmmz dflags then pprTrace x y z else z
diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs
index c063f639af..884846678a 100644
--- a/compiler/cmm/CmmProcPoint.hs
+++ b/compiler/cmm/CmmProcPoint.hs
@@ -13,8 +13,8 @@ import Prelude hiding (last, unzip, succ, zip)
 import BlockId
 import CLabel
 import Cmm
-import CmmDecl
 import CmmExpr
+import CmmUtils
 import CmmContFlowOpt
 import CmmInfo
 import CmmLive
@@ -408,10 +408,9 @@ splitAtProcPoints entry_label callPPs procPoints procMap
      -- Due to common blockification, we may overestimate the set of procpoints.
      let add_label map pp = Map.insert pp lbls map
            where lbls | pp == entry = (entry_label, Just entry_info_lbl)
-                      | otherwise   = (blockLbl pp, guard (setMember pp callPPs) >> Just (infoTblLbl pp))
-                 entry_info_lbl = case info_tbl of
-                     CmmInfoTable entry_info_label _ _ _ _ -> entry_info_label
-                     CmmNonInfoTable -> pprPanic "splitAtProcPoints: looked at info label for entry without info table" (ppr pp)
+                      | otherwise   = (blockLbl pp, guard (setMember pp callPPs) >> 
+                                                    Just (infoTblLbl pp))
+                 entry_info_lbl = cit_lbl info_tbl
          procLabels = foldl add_label Map.empty
                             (filter (flip mapMember (toBlockMap g)) (setElems procPoints))
      -- For each procpoint, we need to know the SP offset on entry.
diff --git a/compiler/cmm/CmmRewriteAssignments.hs b/compiler/cmm/CmmRewriteAssignments.hs
index c0b7510349..c9ac12a6ef 100644
--- a/compiler/cmm/CmmRewriteAssignments.hs
+++ b/compiler/cmm/CmmRewriteAssignments.hs
@@ -16,7 +16,7 @@ module CmmRewriteAssignments
   ) where
 
 import Cmm
-import CmmExpr
+import CmmUtils
 import CmmOpt
 import OptimizationFuel
 import StgCmmUtils
diff --git a/compiler/cmm/CmmSpillReload.hs b/compiler/cmm/CmmSpillReload.hs
index 3033e7b421..9e762fe48a 100644
--- a/compiler/cmm/CmmSpillReload.hs
+++ b/compiler/cmm/CmmSpillReload.hs
@@ -14,7 +14,7 @@ where
 
 import BlockId
 import Cmm
-import CmmExpr
+import CmmUtils
 import CmmLive
 import OptimizationFuel
 
diff --git a/compiler/cmm/CmmStackLayout.hs b/compiler/cmm/CmmStackLayout.hs
index 4c01a1a752..85e4af03be 100644
--- a/compiler/cmm/CmmStackLayout.hs
+++ b/compiler/cmm/CmmStackLayout.hs
@@ -22,7 +22,7 @@ import Prelude hiding (succ, zip, unzip, last)
 
 import BlockId
 import Cmm
-import CmmExpr
+import CmmUtils
 import CmmProcPoint
 import Maybes
 import MkGraph (stackStubExpr)
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index 35f2471361..2dcf5497c8 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE GADTs #-}
 -----------------------------------------------------------------------------
 --
 -- Cmm utilities.
@@ -7,17 +8,49 @@
 -----------------------------------------------------------------------------
 
 module CmmUtils( 
+        -- CmmType
 	primRepCmmType, primRepForeignHint,
 	typeCmmType, typeForeignHint,
 
+	-- CmmLit
+	zeroCLit, mkIntCLit, 
+	mkWordCLit, packHalfWordsCLit,
+	mkByteStringCLit, 
+        mkDataLits, mkRODataLits,
+
+	-- CmmExpr
+	mkLblExpr,
+	cmmRegOff,  cmmOffset,  cmmLabelOff,  cmmOffsetLit,  cmmOffsetExpr, 
+	cmmRegOffB, cmmOffsetB, cmmLabelOffB, cmmOffsetLitB, cmmOffsetExprB,
+	cmmRegOffW, cmmOffsetW, cmmLabelOffW, cmmOffsetLitW, cmmOffsetExprW,
+	cmmIndex, cmmIndexExpr, cmmLoadIndex, cmmLoadIndexW,
+	cmmNegate, 
+  	cmmULtWord, cmmUGeWord, cmmUGtWord, cmmSubWord,
+  	cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord,
+  	cmmUShrWord, cmmAddWord, cmmMulWord,
+
 	isTrivialCmmExpr, hasNoGlobalRegs,
+	
+	-- Statics
+	blankWord,
 
-	cmmRegOff, cmmLabelOff, cmmOffset, cmmOffsetLit, cmmIndex,
-	cmmOffsetExpr, cmmIndexExpr, cmmLoadIndex,
+	-- Tagging
+	cmmTagMask, cmmPointerMask, cmmUntag, cmmGetTag, cmmIsTagged,
+	cmmConstrTag, cmmConstrTag1,
 
- 	mkIntCLit, zeroCLit,
+        -- Liveness and bitmaps
+        mkLiveness,
 
-	mkLblExpr,
+        -- * Operations that probably don't belong here
+        modifyGraph,
+
+        lastNode, replaceLastNode, insertBetween,
+        ofBlockMap, toBlockMap, insertBlock,
+        ofBlockList, toBlockList, bodyToBlockList,
+        foldGraphBlocks, mapGraphNodes, postorderDfs,
+      
+        analFwd, analBwd, analRewFwd, analRewBwd,
+        dataflowPassFwd, dataflowPassBwd
   ) where
 
 #include "HsVersions.h"
@@ -25,10 +58,21 @@ module CmmUtils(
 import TyCon	( PrimRep(..) )
 import Type	( Type, typePrimRep )
 
+import SMRep
+import Cmm
+import BlockId
 import CLabel
-import CmmDecl
-import CmmExpr
 import Outputable
+import OptimizationFuel as F
+import Unique
+import UniqSupply
+import Constants( wORD_SIZE, tAG_MASK )
+
+import Data.Word
+import Data.Maybe
+import Data.Bits
+import Control.Monad
+import Compiler.Hoopl hiding ( Unique )
 
 ---------------------------------------------------
 --
@@ -64,35 +108,68 @@ primRepForeignHint DoubleRep	= NoHint
 typeForeignHint :: Type -> ForeignHint
 typeForeignHint = primRepForeignHint . typePrimRep
 
-
 ---------------------------------------------------
 --
---	CmmExpr
+--	CmmLit
 --
 ---------------------------------------------------
 
-isTrivialCmmExpr :: CmmExpr -> Bool
-isTrivialCmmExpr (CmmLoad _ _)   = False
-isTrivialCmmExpr (CmmMachOp _ _) = False
-isTrivialCmmExpr (CmmLit _)      = True
-isTrivialCmmExpr (CmmReg _)      = True
-isTrivialCmmExpr (CmmRegOff _ _) = True
-isTrivialCmmExpr (CmmStackSlot _ _) = panic "isTrivialCmmExpr CmmStackSlot"
+mkIntCLit :: Int -> CmmLit
+mkIntCLit i = CmmInt (toInteger i) wordWidth
 
-hasNoGlobalRegs :: CmmExpr -> Bool
-hasNoGlobalRegs (CmmLoad e _)   	   = hasNoGlobalRegs e
-hasNoGlobalRegs (CmmMachOp _ es) 	   = all hasNoGlobalRegs es
-hasNoGlobalRegs (CmmLit _)      	   = True
-hasNoGlobalRegs (CmmReg (CmmLocal _))      = True
-hasNoGlobalRegs (CmmRegOff (CmmLocal _) _) = True
-hasNoGlobalRegs _ = False
+zeroCLit :: CmmLit
+zeroCLit = CmmInt 0 wordWidth
+
+mkByteStringCLit :: Unique -> [Word8] -> (CmmLit, GenCmmTop CmmStatics info stmt)
+-- We have to make a top-level decl for the string, 
+-- and return a literal pointing to it
+mkByteStringCLit uniq bytes
+  = (CmmLabel lbl, CmmData ReadOnlyData $ Statics lbl [CmmString bytes])
+  where
+    lbl = mkStringLitLabel uniq
+mkDataLits :: Section -> CLabel -> [CmmLit] -> GenCmmTop CmmStatics info stmt
+-- Build a data-segment data block
+mkDataLits section lbl lits
+  = CmmData section (Statics lbl $ map CmmStaticLit lits)
+
+mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatics info stmt
+-- Build a read-only data block
+mkRODataLits lbl lits
+  = mkDataLits section lbl lits
+  where 
+    section | any needsRelocation lits = RelocatableReadOnlyData
+            | otherwise                = ReadOnlyData
+    needsRelocation (CmmLabel _)      = True
+    needsRelocation (CmmLabelOff _ _) = True
+    needsRelocation _                 = False
+
+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
 
 ---------------------------------------------------
 --
---	Expr Construction helpers
+--	CmmExpr
 --
 ---------------------------------------------------
 
+mkLblExpr :: CLabel -> CmmExpr
+mkLblExpr lbl = CmmLit (CmmLabel lbl)
+
 cmmOffsetExpr :: CmmExpr -> CmmExpr -> CmmExpr
 -- assumes base and offset have the same CmmType
 cmmOffsetExpr e (CmmLit (CmmInt n _)) = cmmOffset e (fromInteger n)
@@ -156,17 +233,272 @@ cmmIndexExpr width base idx =
 cmmLoadIndex :: CmmType -> CmmExpr -> Int -> CmmExpr
 cmmLoadIndex ty expr ix = CmmLoad (cmmIndex (typeWidth ty) expr ix) ty
 
+-- 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
+
 ---------------------------------------------------
 --
---	Literal construction functions
+--	CmmExpr predicates
 --
 ---------------------------------------------------
 
-mkIntCLit :: Int -> CmmLit
-mkIntCLit i = CmmInt (toInteger i) wordWidth
+isTrivialCmmExpr :: CmmExpr -> Bool
+isTrivialCmmExpr (CmmLoad _ _)   = False
+isTrivialCmmExpr (CmmMachOp _ _) = False
+isTrivialCmmExpr (CmmLit _)      = True
+isTrivialCmmExpr (CmmReg _)      = True
+isTrivialCmmExpr (CmmRegOff _ _) = True
+isTrivialCmmExpr (CmmStackSlot _ _) = panic "isTrivialCmmExpr CmmStackSlot"
 
-zeroCLit :: CmmLit
-zeroCLit = CmmInt 0 wordWidth
+hasNoGlobalRegs :: CmmExpr -> Bool
+hasNoGlobalRegs (CmmLoad e _)   	   = hasNoGlobalRegs e
+hasNoGlobalRegs (CmmMachOp _ es) 	   = all hasNoGlobalRegs es
+hasNoGlobalRegs (CmmLit _)      	   = True
+hasNoGlobalRegs (CmmReg (CmmLocal _))      = True
+hasNoGlobalRegs (CmmRegOff (CmmLocal _) _) = True
+hasNoGlobalRegs _ = False
 
-mkLblExpr :: CLabel -> CmmExpr
-mkLblExpr lbl = CmmLit (CmmLabel lbl)
+---------------------------------------------------
+--
+--	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
+
+
+--------------------------------------------
+--
+--        mkLiveness
+--
+---------------------------------------------
+
+mkLiveness :: [Maybe LocalReg] -> Liveness
+mkLiveness [] = []
+mkLiveness (reg:regs) 
+  = take sizeW bits ++ mkLiveness regs 
+  where
+    sizeW = case reg of
+              Nothing -> 1
+              Just r -> (widthInBytes (typeWidth (localRegType r)) + wORD_SIZE - 1)
+                        `quot` wORD_SIZE
+                        -- number of words, rounded up
+    bits = repeat $ is_non_ptr reg -- True <=> Non Ptr
+
+    is_non_ptr Nothing    = True
+    is_non_ptr (Just reg) = not $ isGcPtrType (localRegType reg)
+
+
+-- ============================================== -
+-- ============================================== -
+-- ============================================== -
+
+---------------------------------------------------
+--
+--      Manipulating CmmGraphs
+--
+---------------------------------------------------
+
+modifyGraph :: (Graph n C C -> Graph n' C C) -> GenCmmGraph n -> GenCmmGraph n'
+modifyGraph f g = CmmGraph {g_entry=g_entry g, g_graph=f (g_graph g)}
+
+toBlockMap :: CmmGraph -> LabelMap CmmBlock
+toBlockMap (CmmGraph {g_graph=GMany NothingO body NothingO}) = body
+
+ofBlockMap :: BlockId -> LabelMap CmmBlock -> CmmGraph
+ofBlockMap entry bodyMap = CmmGraph {g_entry=entry, g_graph=GMany NothingO bodyMap NothingO}
+
+insertBlock :: CmmBlock -> LabelMap CmmBlock -> LabelMap CmmBlock
+insertBlock block map =
+  ASSERT (isNothing $ mapLookup id map)
+  mapInsert id block map
+  where id = entryLabel block
+
+toBlockList :: CmmGraph -> [CmmBlock]
+toBlockList g = mapElems $ toBlockMap g
+
+ofBlockList :: BlockId -> [CmmBlock] -> CmmGraph
+ofBlockList entry blocks = CmmGraph {g_entry=entry, g_graph=GMany NothingO body NothingO}
+  where body = foldr addBlock emptyBody blocks
+
+bodyToBlockList :: Body CmmNode -> [CmmBlock]
+bodyToBlockList body = mapElems body
+
+mapGraphNodes :: ( CmmNode C O -> CmmNode C O
+                 , CmmNode O O -> CmmNode O O
+                 , CmmNode O C -> CmmNode O C)
+              -> CmmGraph -> CmmGraph
+mapGraphNodes funs@(mf,_,_) g =
+  ofBlockMap (entryLabel $ mf $ CmmEntry $ g_entry g) $ mapMap (blockMapNodes3 funs) $ toBlockMap g
+
+foldGraphBlocks :: (CmmBlock -> a -> a) -> a -> CmmGraph -> a
+foldGraphBlocks k z g = mapFold k z $ toBlockMap g
+
+postorderDfs :: CmmGraph -> [CmmBlock]
+postorderDfs g = postorder_dfs_from (toBlockMap g) (g_entry g)
+
+-------------------------------------------------
+-- Manipulating CmmBlocks
+
+lastNode :: CmmBlock -> CmmNode O C
+lastNode block = foldBlockNodesF3 (nothing, nothing, const) block ()
+  where nothing :: a -> b -> ()
+        nothing _ _ = ()
+
+replaceLastNode :: Block CmmNode e C -> CmmNode O C -> Block CmmNode e C
+replaceLastNode block last = blockOfNodeList (first, middle, JustC last)
+  where (first, middle, _) = blockToNodeList block
+
+----------------------------------------------------------------------
+----- Splicing between blocks
+-- Given a middle node, a block, and a successor BlockId,
+-- we can insert the middle node between the block and the successor.
+-- We return the updated block and a list of new blocks that must be added
+-- to the graph.
+-- The semantics is a bit tricky. We consider cases on the last node:
+-- o For a branch, we can just insert before the branch,
+--   but sometimes the optimizer does better if we actually insert
+--   a fresh basic block, enabling some common blockification.
+-- o For a conditional branch, switch statement, or call, we must insert
+--   a new basic block.
+-- o For a jump or return, this operation is impossible.
+
+insertBetween :: MonadUnique m => CmmBlock -> [CmmNode O O] -> BlockId -> m (CmmBlock, [CmmBlock])
+insertBetween b ms succId = insert $ lastNode b
+  where insert :: MonadUnique m => CmmNode O C -> m (CmmBlock, [CmmBlock])
+        insert (CmmBranch bid) =
+          if bid == succId then
+            do (bid', bs) <- newBlocks
+               return (replaceLastNode b (CmmBranch bid'), bs)
+          else panic "tried invalid block insertBetween"
+        insert (CmmCondBranch c t f) =
+          do (t', tbs) <- if t == succId then newBlocks else return $ (t, [])
+             (f', fbs) <- if f == succId then newBlocks else return $ (f, [])
+             return (replaceLastNode b (CmmCondBranch c t' f'), tbs ++ fbs)
+        insert (CmmSwitch e ks) =
+          do (ids, bs) <- mapAndUnzipM mbNewBlocks ks
+             return (replaceLastNode b (CmmSwitch e ids), join bs)
+        insert (CmmCall {}) =
+          panic "unimp: insertBetween after a call -- probably not a good idea"
+        insert (CmmForeignCall {}) =
+          panic "unimp: insertBetween after a foreign call -- probably not a good idea"
+
+        newBlocks :: MonadUnique m => m (BlockId, [CmmBlock])
+        newBlocks = do id <- liftM mkBlockId $ getUniqueM
+                       return $ (id, [blockOfNodeList (JustC (CmmEntry id), ms, JustC (CmmBranch succId))])
+        mbNewBlocks :: MonadUnique m => Maybe BlockId -> m (Maybe BlockId, [CmmBlock])
+        mbNewBlocks (Just k) = if k == succId then liftM fstJust newBlocks
+                               else return (Just k, [])
+        mbNewBlocks Nothing  = return (Nothing, [])
+        fstJust (id, bs) = (Just id, bs)
+
+-------------------------------------------------
+-- Running dataflow analysis and/or rewrites
+
+-- Constructing forward and backward analysis-only pass
+analFwd    :: Monad m => DataflowLattice f -> FwdTransfer n f -> FwdPass m n f
+analBwd    :: Monad m => DataflowLattice f -> BwdTransfer n f -> BwdPass m n f
+
+analFwd lat xfer = analRewFwd lat xfer noFwdRewrite
+analBwd lat xfer = analRewBwd lat xfer noBwdRewrite
+
+-- Constructing forward and backward analysis + rewrite pass
+analRewFwd :: Monad m => DataflowLattice f -> FwdTransfer n f -> FwdRewrite m n f -> FwdPass m n f
+analRewBwd :: Monad m => DataflowLattice f -> BwdTransfer n f -> BwdRewrite m n f -> BwdPass m n f
+
+analRewFwd lat xfer rew = FwdPass {fp_lattice = lat, fp_transfer = xfer, fp_rewrite = rew}
+analRewBwd lat xfer rew = BwdPass {bp_lattice = lat, bp_transfer = xfer, bp_rewrite = rew}
+
+-- Running forward and backward dataflow analysis + optional rewrite
+dataflowPassFwd :: NonLocal n => GenCmmGraph n -> [(BlockId, f)] -> FwdPass FuelUniqSM n f -> FuelUniqSM (GenCmmGraph n, BlockEnv f)
+dataflowPassFwd (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd = do
+  (graph, facts, NothingO) <- analyzeAndRewriteFwd fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts)
+  return (CmmGraph {g_entry=entry, g_graph=graph}, facts)
+
+dataflowPassBwd :: NonLocal n => GenCmmGraph n -> [(BlockId, f)] -> BwdPass FuelUniqSM n f -> FuelUniqSM (GenCmmGraph n, BlockEnv f)
+dataflowPassBwd (CmmGraph {g_entry=entry, g_graph=graph}) facts bwd = do
+  (graph, facts, NothingO) <- analyzeAndRewriteBwd bwd (JustC [entry]) graph (mkFactBase (bp_lattice bwd) facts)
+  return (CmmGraph {g_entry=entry, g_graph=graph}, facts)
diff --git a/compiler/cmm/MkGraph.hs b/compiler/cmm/MkGraph.hs
index d1ac5712ab..bc2e4112d9 100644
--- a/compiler/cmm/MkGraph.hs
+++ b/compiler/cmm/MkGraph.hs
@@ -22,17 +22,11 @@ module MkGraph
          , mkReturn, mkReturnSimple, mkComment, mkCallEntry
          , mkBranch, mkCmmIfThenElse, mkCmmIfThen, mkCmmWhileDo
          , copyInOflow, copyInSlot, copyOutOflow, copyOutSlot
-  -- Reexport of needed Cmm stuff
-  , Convention(..), ForeignConvention(..), ForeignTarget(..)
-  , CmmStackInfo(..), CmmTopInfo(..), CmmGraph, GenCmmGraph(..)
-  , Cmm, CmmTop
   )
 where
 
 import BlockId
 import Cmm
-import CmmDecl
-import CmmExpr
 import CmmCallConv (assignArgumentsPos, ParamLocation(..))
 
 import Compiler.Hoopl hiding (Unique, (<*>), mkFirst, mkMiddle, mkLast, mkLabel, mkBranch, Shape(..))
diff --git a/compiler/cmm/OldCmm.hs b/compiler/cmm/OldCmm.hs
index f691183038..2827d04cfd 100644
--- a/compiler/cmm/OldCmm.hs
+++ b/compiler/cmm/OldCmm.hs
@@ -7,26 +7,33 @@
 -----------------------------------------------------------------------------
 
 module OldCmm (
-        Cmm, RawCmm, CmmTop, RawCmmTop,
+        CmmPgm, GenCmmPgm, RawCmmPgm, CmmTop, RawCmmTop,
         ListGraph(..),
-        CmmInfo(..), UpdateFrame(..),
+        CmmInfo(..), UpdateFrame(..), CmmInfoTable(..), ClosureTypeInfo(..),
+        CmmStatic(..), CmmStatics(..), CmmFormal, CmmActual,
         cmmMapGraph, cmmTopMapGraph,
         cmmMapGraphM, cmmTopMapGraphM,
         GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts,
         CmmStmt(..), CmmReturnInfo(..), CmmHinted(..),
         HintedCmmFormal, HintedCmmActual,
         CmmSafety(..), CmmCallTarget(..),
-        module CmmDecl,
+        New.GenCmmTop(..),
+        New.ForeignHint(..),
         module CmmExpr,
+        Section(..),
+        ProfilingInfo(..), C_SRT(..)
   ) where
 
 #include "HsVersions.h"
 
+import qualified Cmm as New
+import Cmm           ( CmmInfoTable(..), GenCmmPgm, CmmStatics(..), GenCmmTop(..),
+                       CmmFormal, CmmActual, Section(..), CmmStatic(..),
+                       ProfilingInfo(..), ClosureTypeInfo(..) )
+
 import BlockId
-import CmmDecl
 import CmmExpr
 import ForeignCall
-
 import ClosureInfo
 import Outputable
 import FastString
@@ -73,14 +80,14 @@ newtype ListGraph i = ListGraph [GenBasicBlock i]
    -- across a whole compilation unit.
 
 -- | Cmm with the info table as a data type
-type Cmm    = GenCmm    CmmStatics CmmInfo (ListGraph CmmStmt)
+type CmmPgm = GenCmmPgm CmmStatics CmmInfo (ListGraph CmmStmt)
 type CmmTop = GenCmmTop CmmStatics CmmInfo (ListGraph CmmStmt)
 
 -- | Cmm with the info tables converted to a list of 'CmmStatic' along with the info
 -- table label. If we are building without tables-next-to-code there will be no statics
 --
 -- INVARIANT: if there is an info table, it has at least one CmmStatic
-type RawCmm    = GenCmm    CmmStatics (Maybe CmmStatics) (ListGraph CmmStmt)
+type RawCmmPgm = GenCmmPgm CmmStatics (Maybe CmmStatics) (ListGraph CmmStmt)
 type RawCmmTop = GenCmmTop CmmStatics (Maybe CmmStatics) (ListGraph CmmStmt)
 
 
@@ -111,17 +118,17 @@ mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs)
 --   graph maps
 ----------------------------------------------------------------
 
-cmmMapGraph    :: (g -> g') -> GenCmm    d h g -> GenCmm    d h g'
+cmmMapGraph    :: (g -> g') -> GenCmmPgm d h g -> GenCmmPgm d h g'
 cmmTopMapGraph :: (g -> g') -> GenCmmTop d h g -> GenCmmTop d h g'
 
-cmmMapGraphM    :: Monad m => (String -> g -> m g') -> GenCmm    d h g -> m (GenCmm    d h g')
+cmmMapGraphM    :: Monad m => (String -> g -> m g') -> GenCmmPgm d h g -> m (GenCmmPgm d h g')
 cmmTopMapGraphM :: Monad m => (String -> g -> m g') -> GenCmmTop d h g -> m (GenCmmTop d h g')
 
-cmmMapGraph f (Cmm tops) = Cmm $ map (cmmTopMapGraph f) tops
+cmmMapGraph f tops = map (cmmTopMapGraph f) tops
 cmmTopMapGraph f (CmmProc h l g) = CmmProc h l (f g)
 cmmTopMapGraph _ (CmmData s ds)  = CmmData s ds
 
-cmmMapGraphM f (Cmm tops) = mapM (cmmTopMapGraphM f) tops >>= return . Cmm
+cmmMapGraphM f tops = mapM (cmmTopMapGraphM f) tops
 cmmTopMapGraphM f (CmmProc h l g) =
   f (showSDoc $ ppr l) g >>= return . CmmProc h l
 cmmTopMapGraphM _ (CmmData s ds)  = return $ CmmData s ds
@@ -172,7 +179,7 @@ data CmmStmt	-- Old-style
   | CmmReturn            -- Return from a native C-- function,
       [HintedCmmActual]        -- with these return values. (parameters never used)
 
-data CmmHinted a = CmmHinted { hintlessCmm :: a, cmmHint :: ForeignHint }
+data CmmHinted a = CmmHinted { hintlessCmm :: a, cmmHint :: New.ForeignHint }
 	   	 deriving( Eq )
 
 type HintedCmmFormal  = CmmHinted CmmFormal
diff --git a/compiler/cmm/OldPprCmm.hs b/compiler/cmm/OldPprCmm.hs
index 4050359710..b31cc96dbc 100644
--- a/compiler/cmm/OldPprCmm.hs
+++ b/compiler/cmm/OldPprCmm.hs
@@ -86,19 +86,13 @@ instance Outputable CmmSafety where
 -- style of C--'s 'stackdata' declaration, just inside the proc body,
 -- and were labelled with the procedure name ++ "_info".
 pprInfo :: CmmInfo -> SDoc
-pprInfo (CmmInfo _gc_target update_frame CmmNonInfoTable) =
-    vcat [{-ptext (sLit "gc_target: ") <>
-                maybe (ptext (sLit "<none>")) ppr gc_target,-}
-          ptext (sLit "update_frame: ") <>
-                maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame]
-pprInfo (CmmInfo _gc_target update_frame info_table@(CmmInfoTable _ _ _ _ _)) =
+pprInfo (CmmInfo _gc_target update_frame info_table) =
     vcat [{-ptext (sLit "gc_target: ") <>
                 maybe (ptext (sLit "<none>")) ppr gc_target,-}
           ptext (sLit "update_frame: ") <>
                 maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame,
           ppr info_table]
 
-
 -- --------------------------------------------------------------------------
 -- Basic blocks look like assembly blocks.
 --      lbl: stmt ; stmt ; ..
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 51b0031ad3..80135503ff 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -65,7 +65,7 @@ import Control.Monad.ST
 -- --------------------------------------------------------------------------
 -- Top level
 
-pprCs :: DynFlags -> [RawCmm] -> SDoc
+pprCs :: DynFlags -> [RawCmmPgm] -> SDoc
 pprCs dflags cmms
  = pprCode CStyle (vcat $ map (\c -> split_marker $$ pprC c) cmms)
  where
@@ -73,7 +73,7 @@ pprCs dflags cmms
      | dopt Opt_SplitObjs dflags = ptext (sLit "__STG_SPLIT_MARKER")
      | otherwise                 = empty
 
-writeCs :: DynFlags -> Handle -> [RawCmm] -> IO ()
+writeCs :: DynFlags -> Handle -> [RawCmmPgm] -> IO ()
 writeCs dflags handle cmms 
   = printForC handle (pprCs dflags cmms)
 
@@ -83,8 +83,8 @@ writeCs dflags handle cmms
 -- for fun, we could call cmmToCmm over the tops...
 --
 
-pprC :: RawCmm -> SDoc
-pprC (Cmm tops) = vcat $ intersperse blankLine $ map pprTop tops
+pprC :: RawCmmPgm -> SDoc
+pprC tops = vcat $ intersperse blankLine $ map pprTop tops
 
 --
 -- top level procs
diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index 43e1c5bb2f..521ab059b7 100644
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -40,8 +40,7 @@ where
 import BlockId ()
 import CLabel
 import Cmm
-import CmmExpr
-import CmmUtils (isTrivialCmmExpr)
+import CmmUtils
 import FastString
 import Outputable
 import PprCmmDecl
diff --git a/compiler/cmm/PprCmmDecl.hs b/compiler/cmm/PprCmmDecl.hs
index f688f211fb..c973f2d2f0 100644
--- a/compiler/cmm/PprCmmDecl.hs
+++ b/compiler/cmm/PprCmmDecl.hs
@@ -33,14 +33,13 @@
 --
 
 module PprCmmDecl
-    ( writeCmms, pprCmms, pprCmm, pprSection, pprStatic
+    ( writeCmms, pprCmms, pprCmmPgm, pprSection, pprStatic
     )
 where
 
-import CmmDecl
 import CLabel
 import PprCmmExpr
-
+import Cmm
 
 import Outputable
 import Platform
@@ -51,26 +50,21 @@ import System.IO
 
 -- Temp Jan08
 import SMRep
-import ClosureInfo
 #include "../includes/rts/storage/FunTypes.h"
 
 
 pprCmms :: (Outputable info, PlatformOutputable g)
-        => Platform -> [GenCmm CmmStatics info g] -> SDoc
+        => Platform -> [GenCmmPgm CmmStatics info g] -> SDoc
 pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pprPlatform platform) cmms))
         where
           separator = space $$ ptext (sLit "-------------------") $$ space
 
 writeCmms :: (Outputable info, PlatformOutputable g)
-          => Platform -> Handle -> [GenCmm CmmStatics info g] -> IO ()
+          => Platform -> Handle -> [GenCmmPgm CmmStatics info g] -> IO ()
 writeCmms platform handle cmms = printForC handle (pprCmms platform cmms)
 
 -----------------------------------------------------------------------------
 
-instance (Outputable d, Outputable info, PlatformOutputable g)
-      => PlatformOutputable (GenCmm d info g) where
-    pprPlatform platform c = pprCmm platform c
-
 instance (Outputable d, Outputable info, PlatformOutputable i)
       => PlatformOutputable (GenCmmTop d info i) where
     pprPlatform platform t = pprTop platform t
@@ -87,9 +81,9 @@ instance Outputable CmmInfoTable where
 
 -----------------------------------------------------------------------------
 
-pprCmm :: (Outputable d, Outputable info, PlatformOutputable g)
-       => Platform -> GenCmm d info g -> SDoc
-pprCmm platform (Cmm tops)
+pprCmmPgm :: (Outputable d, Outputable info, PlatformOutputable g)
+       => Platform -> GenCmmPgm d info g -> SDoc
+pprCmmPgm platform tops
     = vcat $ intersperse blankLine $ map (pprTop platform) tops
 
 -- --------------------------------------------------------------------------
@@ -118,55 +112,22 @@ pprTop _ (CmmData section ds) =
 -- Info tables.
 
 pprInfoTable :: CmmInfoTable -> SDoc
-pprInfoTable CmmNonInfoTable = empty
-pprInfoTable (CmmInfoTable is_local stat_clos (ProfilingInfo closure_type closure_desc) tag info) =
-    vcat [ptext (sLit "is local: ") <> ppr is_local <+>
-          ptext (sLit "has static closure: ") <> ppr stat_clos <+>
-          ptext (sLit "type: ") <> pprLit closure_type,
-          ptext (sLit "desc: ") <> pprLit closure_desc,
-          ptext (sLit "tag: ") <> integer (toInteger tag),
-          pprTypeInfo info]
-
-pprTypeInfo :: ClosureTypeInfo -> SDoc
-pprTypeInfo (ConstrInfo layout constr descr) =
-    vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
-          ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
-          ptext (sLit "constructor: ") <> integer (toInteger constr),
-          pprLit descr]
-pprTypeInfo (FunInfo layout srt arity _args slow_entry) =
-    vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
-          ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
-          ptext (sLit "srt: ") <> ppr srt,
--- Temp Jan08
-          ptext (sLit ("fun_type: ")) <> integer (toInteger (argDescrType _args)),
-
-          ptext (sLit "arity: ") <> integer (toInteger arity),
-          --ptext (sLit "args: ") <> ppr args, -- TODO: needs to be printed
-          ptext (sLit "slow: ") <> pprLit slow_entry
-         ]
-pprTypeInfo (ThunkInfo layout srt) =
-    vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
-          ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
-          ptext (sLit "srt: ") <> ppr srt]
-pprTypeInfo (ThunkSelectorInfo offset srt) =
-    vcat [ptext (sLit "ptrs: ") <> integer (toInteger offset),
-          ptext (sLit "srt: ") <> ppr srt]
-pprTypeInfo (ContInfo stack srt) =
-    vcat [ptext (sLit "stack: ") <> ppr stack,
-          ptext (sLit "srt: ") <> ppr srt]
-
--- Temp Jan08
-argDescrType :: ArgDescr -> StgHalfWord
--- The "argument type" RTS field type
-argDescrType (ArgSpec n) = n
-argDescrType (ArgGen liveness)
-  | isBigLiveness liveness = ARG_GEN_BIG
-  | otherwise		   = ARG_GEN
-
--- Temp Jan08
-isBigLiveness :: Liveness -> Bool
-isBigLiveness (BigLiveness _)   = True
-isBigLiveness (SmallLiveness _) = False
+pprInfoTable CmmNonInfoTable 
+  = empty
+pprInfoTable (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
+                           , cit_prof = prof_info
+                           , cit_srt = _srt })  
+  = vcat [ ptext (sLit "label:") <+> ppr lbl
+         , ptext (sLit "rep:") <> ppr rep
+         , case prof_info of
+	     NoProfilingInfo -> empty
+             ProfilingInfo ct cd -> vcat [ ptext (sLit "type:") <+> pprWord8String ct
+                                         , ptext (sLit "desc: ") <> pprWord8String cd ] ]
+
+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))
 
 instance Outputable ForeignHint where
   ppr NoHint     = empty
diff --git a/compiler/cmm/cmm-notes b/compiler/cmm/cmm-notes
index 5cfd5f2788..e9a6a60b5f 100644
--- a/compiler/cmm/cmm-notes
+++ b/compiler/cmm/cmm-notes
@@ -17,6 +17,9 @@ Things we did
 

 More notes (June 11)

 ~~~~~~~~~~~~~~~~~~~~

+* Check in ClosureInfo:

+     -- NB: Results here should line up with the results of SMRep.rtsClosureType

+

 * Possible refactoring: Nuke AGraph in favour of 

       mkIfThenElse :: Expr -> Graph -> Graph -> FCode Graph

   or even

@@ -248,6 +251,60 @@ Things to do:
 	 (guided by the procpoint set)

 

 ----------------------------------------------------

+	Modules in codeGen/

+----------------------------------------------------

+

+

+------- Shared ---------

+Bitmap.hs

+SMRep.lhs

+

+CmmParse.y

+CgExtCode.hs   used in CmmParse.y

+

+------- New codegen ---------

+

+StgCmm.hs

+StgCmmBind.hs

+StgCmmClosure.hs     (corresponds to old ClosureInfo)

+StgCmmCon.hs

+StgCmmEnv.hs

+StgCmmExpr.hs

+StgCmmForeign.hs

+StgCmmGran.hs

+StgCmmHeap.hs

+StgCmmHpc.hs

+StgCmmLayout.hs

+StgCmmMonad.hs

+StgCmmPrim.hs

+StgCmmProf.hs

+StgCmmTicky.hs

+StgCmmUtils.hs

+

+------- Old codegen (moribund) ---------

+CodeGen.lhs

+CgBindery.lhs

+CgCallConv.hs

+CgCase.lhs

+CgClosure.lhs

+CgCon.lhs

+CgExpr.lhs

+CgLetNoEscape.lhs

+CgForeignCall.hs

+CgHeapery.lhs

+CgHpc.hs

+CgInfoTbls.hs

+CgMonad.lhs

+CgParallel.hs

+CgPrimOp.hs

+CgProf.hs

+CgStackery.lhs

+CgTailCall.lhs

+CgTicky.hs

+CgUtils.hs

+ClosureInfo.lhs

+

+----------------------------------------------------

 	Modules in cmm/

 ----------------------------------------------------

 

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
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index e393bb7e7f..d553e5d63c 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -187,7 +187,6 @@ Library
         CmmCommonBlockElim
         CmmContFlowOpt
         CmmCvt
-        CmmDecl
         CmmExpr
         CmmInfo
         CmmLex
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
index be5c79cf64..e9c50b25ef 100644
--- a/compiler/llvmGen/LlvmCodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen.hs
@@ -33,9 +33,9 @@ import System.IO
 -- -----------------------------------------------------------------------------
 -- | Top-level of the LLVM Code generator
 --
-llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO ()
+llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmmPgm] -> IO ()
 llvmCodeGen dflags h us cmms
-  = let cmm = concat $ map (\(Cmm top) -> top) cmms
+  = let cmm = concat cmms
         (cdata,env) = foldr split ([],initLlvmEnv) cmm
         split (CmmData s d' ) (d,e) = ((s,d'):d,e)
         split (CmmProc i l _) (d,e) =
@@ -115,7 +115,7 @@ cmmLlvmGen dflags us env cmm = do
     let fixed_cmm = fixStgRegisters cmm
 
     dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm"
-        (pprCmm (targetPlatform dflags) $ Cmm [fixed_cmm])
+        (pprCmmPgm (targetPlatform dflags) [fixed_cmm])
 
     -- generate llvm code from cmm
     let ((env', llvmBC), usGen) = initUs us $ genLlvmProc env fixed_cmm
diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs
index 3ff35b6b92..597f9621d3 100644
--- a/compiler/main/CodeOutput.lhs
+++ b/compiler/main/CodeOutput.lhs
@@ -18,7 +18,7 @@ import PprC		( writeCs )
 import CmmLint		( cmmLint )
 import Packages
 import Util
-import OldCmm		( RawCmm )
+import OldCmm           ( RawCmmPgm )
 import HscTypes
 import DynFlags
 import Config
@@ -48,7 +48,7 @@ codeOutput :: DynFlags
 	   -> ModLocation
 	   -> ForeignStubs
 	   -> [PackageId]
-	   -> [RawCmm]			-- Compiled C--
+           -> [RawCmmPgm]                       -- Compiled C--
            -> IO (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-})
 
 codeOutput dflags this_mod location foreign_stubs pkg_deps flat_abstractC
@@ -96,7 +96,7 @@ doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action
 \begin{code}
 outputC :: DynFlags
         -> FilePath
-        -> [RawCmm]
+        -> [RawCmmPgm]
         -> [PackageId]
         -> IO ()
 
@@ -134,7 +134,7 @@ outputC dflags filenm flat_absC packages
 %************************************************************************
 
 \begin{code}
-outputAsm :: DynFlags -> FilePath -> [RawCmm] -> IO ()
+outputAsm :: DynFlags -> FilePath -> [RawCmmPgm] -> IO ()
 outputAsm dflags filenm flat_absC
  | cGhcWithNativeCodeGen == "YES"
   = do ncg_uniqs <- mkSplitUniqSupply 'n'
@@ -155,7 +155,7 @@ outputAsm dflags filenm flat_absC
 %************************************************************************
 
 \begin{code}
-outputLlvm :: DynFlags -> FilePath -> [RawCmm] -> IO ()
+outputLlvm :: DynFlags -> FilePath -> [RawCmmPgm] -> IO ()
 outputLlvm dflags filenm flat_absC
   = do ncg_uniqs <- mkSplitUniqSupply 'n'
        doOutput filenm $ \f -> llvmCodeGen dflags f ncg_uniqs flat_absC
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 5b23876b36..03530b1e54 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -283,7 +283,6 @@ data DynFlag
 	-- temporary flags
    | Opt_RunCPS
    | Opt_RunCPSZ
-   | Opt_ConvertToZipCfgAndBack
    | Opt_AutoLinkPackages
    | Opt_ImplicitImportQualified
    | Opt_TryNewCodeGen
@@ -1734,7 +1733,6 @@ fFlags = [
   ( "run-cps",                          AlwaysAllowed, Opt_RunCPS, nop ),
   ( "run-cpsz",                         AlwaysAllowed, Opt_RunCPSZ, nop ),
   ( "new-codegen",                      AlwaysAllowed, Opt_TryNewCodeGen, nop ),
-  ( "convert-to-zipper-and-back",       AlwaysAllowed, Opt_ConvertToZipCfgAndBack, nop ),
   ( "vectorise",                        AlwaysAllowed, Opt_Vectorise, nop ),
   ( "regs-graph",                       AlwaysAllowed, Opt_RegsGraph, nop ),
   ( "regs-iterative",                   AlwaysAllowed, Opt_RegsIterative, nop ),
diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index ae858fde28..c43c396c64 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -115,7 +115,7 @@ import TyCon            ( TyCon, isDataTyCon )
 import Name		( Name, NamedThing(..) )
 import SimplStg		( stg2stg )
 import CodeGen		( codeGen )
-import OldCmm           ( Cmm )
+import OldCmm as Old    ( CmmPgm )
 import PprCmm		( pprCmms )
 import CmmParse		( parseCmmFile )
 import CmmBuildInfoTables
@@ -123,7 +123,6 @@ import CmmPipeline
 import CmmInfo
 import OptimizationFuel ( initOptFuelState )
 import CmmCvt
-import CmmContFlowOpt   ( runCmmContFlowOpts )
 import CodeOutput
 import NameEnv          ( emptyNameEnv )
 import NameSet          ( emptyNameSet )
@@ -1114,17 +1113,14 @@ hscGenHardCode cgguts mod_summary
          ------------------  Code generation ------------------
          
          cmms <- if dopt Opt_TryNewCodeGen dflags
-                 then do cmms <- tryNewCodeGen hsc_env this_mod data_tycons
+                 then tryNewCodeGen hsc_env this_mod data_tycons
                                  cost_centre_info
                                  stg_binds hpc_info
-                         return cmms
                  else {-# SCC "CodeGen" #-}
                        codeGen dflags this_mod data_tycons
                                cost_centre_info
                                stg_binds hpc_info
 
-         --- Optionally run experimental Cmm transformations ---
-         cmms <- optionallyConvertAndOrCPS hsc_env cmms
                  -- unless certain dflags are on, the identity function
          ------------------  Code output -----------------------
          rawcmms <- cmmToRawCmm cmms
@@ -1179,8 +1175,7 @@ hscCompileCmmFile hsc_env filename
       let dflags = hsc_dflags hsc_env
       cmm <- ioMsgMaybe $ parseCmmFile dflags filename
       liftIO $ do
-        cmms <- optionallyConvertAndOrCPS hsc_env [cmm]
-        rawCmms <- cmmToRawCmm cmms
+        rawCmms <- cmmToRawCmm [cmm]
         _ <- codeOutput dflags no_mod no_loc NoStubs [] rawCmms
         return ()
   where
@@ -1195,7 +1190,7 @@ tryNewCodeGen   :: HscEnv -> Module -> [TyCon]
                 -> CollectedCCs
                 -> [(StgBinding,[(Id,[Id])])]
                 -> HpcInfo
-                -> IO [Cmm]
+                -> IO [Old.CmmPgm]
 tryNewCodeGen hsc_env this_mod data_tycons
               cost_centre_info stg_binds hpc_info =
   do    { let dflags = hsc_dflags hsc_env
@@ -1216,38 +1211,6 @@ tryNewCodeGen hsc_env this_mod data_tycons
         ; return prog' }
 
 
-optionallyConvertAndOrCPS :: HscEnv -> [Cmm] -> IO [Cmm]
-optionallyConvertAndOrCPS hsc_env cmms =
-    do let dflags = hsc_dflags hsc_env
-        --------  Optionally convert to and from zipper ------
-       cmms <- if dopt Opt_ConvertToZipCfgAndBack dflags
-               then mapM (testCmmConversion hsc_env) cmms
-               else return cmms
-       return cmms
-
-
-testCmmConversion :: HscEnv -> Cmm -> IO Cmm
-testCmmConversion hsc_env cmm =
-    do let dflags = hsc_dflags hsc_env
-           platform = targetPlatform dflags
-       showPass dflags "CmmToCmm"
-       dumpIfSet_dyn dflags Opt_D_dump_cvt_cmm "C-- pre-conversion" (pprPlatform platform cmm)
-       --continuationC <- cmmCPS dflags abstractC >>= cmmToRawCmm
-       us <- mkSplitUniqSupply 'C'
-       let zgraph = initUs_ us (cmmToZgraph platform cmm)
-       chosen_graph <-
-        if dopt Opt_RunCPSZ dflags
-            then do us <- mkSplitUniqSupply 'S'
-                    let topSRT = initUs_ us emptySRT
-                    (_, [zgraph]) <- cmmPipeline hsc_env (topSRT, []) zgraph
-                    return zgraph
-            else return (runCmmContFlowOpts zgraph)
-       dumpIfSet_dyn dflags Opt_D_dump_cmmz "C-- Zipper Graph" (pprPlatform platform chosen_graph)
-       showPass dflags "Convert from Z back to Cmm"
-       let cvt = cmmOfZgraph chosen_graph
-       dumpIfSet_dyn dflags Opt_D_dump_cvt_cmm "C-- post-conversion" (pprPlatform platform cvt)
-       return cvt
-
 myCoreToStg :: DynFlags -> Module -> [CoreBind]
             -> IO ( [(StgBinding,[(Id,[Id])])]  -- output program
 	          , CollectedCCs) -- cost centre info (declared and used)
diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 350f533d85..aabe39af85 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -148,7 +148,7 @@ data NcgImpl statics instr jumpDest = NcgImpl {
     }
 
 --------------------
-nativeCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO ()
+nativeCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmmPgm] -> IO ()
 nativeCodeGen dflags h us cmms
  = let nCG' :: (Outputable statics, PlatformOutputable instr, Instruction instr) => NcgImpl statics instr jumpDest -> IO ()
        nCG' ncgImpl = nativeCodeGen' dflags ncgImpl h us cmms
@@ -209,7 +209,7 @@ nativeCodeGen dflags h us cmms
 nativeCodeGen' :: (Outputable statics, PlatformOutputable instr, Instruction instr)
                => DynFlags
                -> NcgImpl statics instr jumpDest
-               -> Handle -> UniqSupply -> [RawCmm] -> IO ()
+               -> Handle -> UniqSupply -> [RawCmmPgm] -> IO ()
 nativeCodeGen' dflags ncgImpl h us cmms
  = do
 	let platform = targetPlatform dflags
@@ -264,7 +264,7 @@ nativeCodeGen' dflags ncgImpl h us cmms
 
 	return	()
 
- where	add_split (Cmm tops)
+ where  add_split tops
 		| dopt Opt_SplitObjs dflags = split_marker : tops
 		| otherwise		    = tops
 
@@ -356,7 +356,7 @@ cmmNativeGen dflags ncgImpl us cmm count
 
 	dumpIfSet_dyn dflags
 		Opt_D_dump_opt_cmm "Optimised Cmm"
-		(pprCmm platform $ Cmm [opt_cmm])
+                (pprCmmPgm platform [opt_cmm])
 
 	-- generate native code from cmm
 	let ((native, lastMinuteImports), usGen) =
diff --git a/compiler/nativeGen/Instruction.hs b/compiler/nativeGen/Instruction.hs
index b2db2ef206..31827b9088 100644
--- a/compiler/nativeGen/Instruction.hs
+++ b/compiler/nativeGen/Instruction.hs
@@ -37,7 +37,7 @@ noUsage  = RU [] []
 -- Our flavours of the Cmm types
 -- Type synonyms for Cmm populated with native code
 type NatCmm instr
-        = GenCmm
+        = GenCmmPgm
                 CmmStatics
                 (Maybe CmmStatics)
                 (ListGraph instr)
diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index 35d4387dd3..c37fc26f72 100644
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -434,6 +434,7 @@ unpackFS (FastString _ n_bytes _ buf enc) =
         ZEncoded      -> peekCAStringLen (castPtr ptr,n_bytes)
         UTF8Encoded _ -> utf8DecodeString ptr n_bytes
 
+-- | Gives the UTF-8 encoded bytes corresponding to a 'FastString'
 bytesFS :: FastString -> [Word8]
 bytesFS (FastString _ n_bytes _ buf _) =
   inlinePerformIO $ withForeignPtr buf $ \ptr ->
diff --git a/includes/rts/storage/InfoTables.h b/includes/rts/storage/InfoTables.h
index cbfb0327c2..4b0c40bbce 100644
--- a/includes/rts/storage/InfoTables.h
+++ b/includes/rts/storage/InfoTables.h
@@ -214,7 +214,7 @@ typedef union {
  */
 typedef struct StgInfoTable_ {
 
-#ifndef TABLES_NEXT_TO_CODE
+#if !defined(TABLES_NEXT_TO_CODE)
     StgFunPtr       entry;	/* pointer to the entry code */
 #endif
 
@@ -344,11 +344,11 @@ typedef struct StgConInfoTable_ {
     StgInfoTable i;
 #endif
 
-#ifndef TABLES_NEXT_TO_CODE
-    char *con_desc;
-#else
+#if defined(TABLES_NEXT_TO_CODE)
     OFFSET_FIELD(con_desc) // the name of the data constructor 
                            // as: Package:Module.Name
+#else
+    char *con_desc;
 #endif
 
 #if defined(TABLES_NEXT_TO_CODE)