Snapshot of codegen refactoring to share with simonpj

25 files changed, 960 insertions, 746 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/

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