* Refactor CLabel.RtsLabel to CLabel.CmmLabel

The type of the CmmLabel ctor is now
  CmmLabel :: PackageId -> FastString -> CmmLabelInfo -> CLabel
  
 - When you construct a CmmLabel you have to explicitly say what
   package it is in. Many of these will just use rtsPackageId, but
   I've left it this way to remind people not to pretend labels are
   in the RTS package when they're not. 
   
 - When parsing a Cmm file, labels that are not defined in the 
   current file are assumed to be in the RTS package. 
   
   Labels imported like
      import label
   are assumed to be in a generic "foreign" package, which is different
   from the current one.
   
   Labels imported like
      import "package-name" label
   are marked as coming from the named package.
   
   This last one is needed for the integer-gmp library as we want to
   refer to labels that are not in the same compilation unit, but
   are in the same non-rts package.
   
   This should help remove the nasty #ifdef __PIC__ stuff from
   integer-gmp/cbits/gmp-wrappers.cmm
   

23 files changed, 446 insertions, 256 deletions

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 8b8a7f98e6..7dde9f9f75 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -73,13 +73,13 @@ module CLabel (
 	mkSelectorInfoLabel,
 	mkSelectorEntryLabel,
 
-	mkRtsInfoLabel,
-	mkRtsEntryLabel,
-	mkRtsRetInfoLabel,
-	mkRtsRetLabel,
-	mkRtsCodeLabel,
-	mkRtsDataLabel,
-	mkRtsGcPtrLabel,
+	mkCmmInfoLabel,
+	mkCmmEntryLabel,
+	mkCmmRetInfoLabel,
+	mkCmmRetLabel,
+	mkCmmCodeLabel,
+	mkCmmDataLabel,
+	mkCmmGcPtrLabel,
 
 	mkRtsApFastLabel,
 
@@ -164,7 +164,7 @@ data CLabel
   
   -- | A label from a .cmm file that is not associated with a .hs level Id.
   | CmmLabel			
-	Module			-- what Cmm source module the label belongs to
+	PackageId		-- what package the label belongs to.
 	FastString		-- identifier giving the prefix of the label
 	CmmLabelInfo		-- encodes the suffix of the label
 
@@ -342,38 +342,30 @@ mkStaticInfoTableLabel name c     = IdLabel    name c StaticInfoTable
 mkConEntryLabel name        c     = IdLabel name c ConEntry
 mkStaticConEntryLabel name  c     = IdLabel name c StaticConEntry
 
-
 -- Constructing Cmm Labels
-
--- | Pretend that wired-in names from the RTS are in a top-level module called RTS, 
---      located in the RTS package. It doesn't matter what module they're actually in
---      as long as that module is in the correct package.
-topRtsModule :: Module
-topRtsModule = mkModule rtsPackageId (mkModuleNameFS (fsLit "RTS"))
-
-mkSplitMarkerLabel		= CmmLabel topRtsModule (fsLit "__stg_split_marker")	CmmCode
-mkDirty_MUT_VAR_Label		= CmmLabel topRtsModule (fsLit "dirty_MUT_VAR")		CmmCode
-mkUpdInfoLabel			= CmmLabel topRtsModule (fsLit "stg_upd_frame")		CmmInfo
-mkIndStaticInfoLabel		= CmmLabel topRtsModule (fsLit "stg_IND_STATIC")	CmmInfo
-mkMainCapabilityLabel		= CmmLabel topRtsModule (fsLit "MainCapability")	CmmData
-mkMAP_FROZEN_infoLabel		= CmmLabel topRtsModule (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
-mkMAP_DIRTY_infoLabel		= CmmLabel topRtsModule (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
-mkEMPTY_MVAR_infoLabel		= CmmLabel topRtsModule (fsLit "stg_EMPTY_MVAR")	CmmInfo
-mkTopTickyCtrLabel		= CmmLabel topRtsModule (fsLit "top_ct")		CmmData
-mkCAFBlackHoleInfoTableLabel	= CmmLabel topRtsModule (fsLit "stg_CAF_BLACKHOLE")	CmmInfo
+mkSplitMarkerLabel		= CmmLabel rtsPackageId (fsLit "__stg_split_marker")	CmmCode
+mkDirty_MUT_VAR_Label		= CmmLabel rtsPackageId (fsLit "dirty_MUT_VAR")		CmmCode
+mkUpdInfoLabel			= CmmLabel rtsPackageId (fsLit "stg_upd_frame")		CmmInfo
+mkIndStaticInfoLabel		= CmmLabel rtsPackageId (fsLit "stg_IND_STATIC")	CmmInfo
+mkMainCapabilityLabel		= CmmLabel rtsPackageId (fsLit "MainCapability")	CmmData
+mkMAP_FROZEN_infoLabel		= CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
+mkMAP_DIRTY_infoLabel		= CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
+mkEMPTY_MVAR_infoLabel		= CmmLabel rtsPackageId (fsLit "stg_EMPTY_MVAR")	CmmInfo
+mkTopTickyCtrLabel		= CmmLabel rtsPackageId (fsLit "top_ct")		CmmData
+mkCAFBlackHoleInfoTableLabel	= CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE")	CmmInfo
 
 -----
-mkRtsInfoLabel,   mkRtsEntryLabel, mkRtsRetInfoLabel, mkRtsRetLabel,
-  mkRtsCodeLabel, mkRtsDataLabel,  mkRtsGcPtrLabel
-	:: FastString -> CLabel
+mkCmmInfoLabel,   mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
+  mkCmmCodeLabel, mkCmmDataLabel,  mkCmmGcPtrLabel
+	:: PackageId -> FastString -> CLabel
 
-mkRtsInfoLabel      str 	= CmmLabel topRtsModule str CmmInfo
-mkRtsEntryLabel     str 	= CmmLabel topRtsModule str CmmEntry
-mkRtsRetInfoLabel   str 	= CmmLabel topRtsModule str CmmRetInfo
-mkRtsRetLabel       str 	= CmmLabel topRtsModule str CmmRet
-mkRtsCodeLabel      str		= CmmLabel topRtsModule str CmmCode
-mkRtsDataLabel      str		= CmmLabel topRtsModule str CmmData
-mkRtsGcPtrLabel     str		= CmmLabel topRtsModule str CmmGcPtr
+mkCmmInfoLabel      pkg str 	= CmmLabel pkg str CmmInfo
+mkCmmEntryLabel     pkg str 	= CmmLabel pkg str CmmEntry
+mkCmmRetInfoLabel   pkg str 	= CmmLabel pkg str CmmRetInfo
+mkCmmRetLabel       pkg str 	= CmmLabel pkg str CmmRet
+mkCmmCodeLabel      pkg str	= CmmLabel pkg str CmmCode
+mkCmmDataLabel      pkg str	= CmmLabel pkg str CmmData
+mkCmmGcPtrLabel     pkg str	= CmmLabel pkg str CmmGcPtr
 
 
 -- Constructing RtsLabels
@@ -740,8 +732,9 @@ idInfoLabelType info =
 labelDynamic :: PackageId -> CLabel -> Bool
 labelDynamic this_pkg lbl =
   case lbl of
-   RtsLabel _  	     -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
-   IdLabel n _ k       -> isDllName this_pkg n
+   RtsLabel _  	     	-> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
+   CmmLabel pkg _ _	-> not opt_Static && (this_pkg /= pkg)
+   IdLabel n _ k     	-> isDllName this_pkg n
 #if mingw32_TARGET_OS
    ForeignLabel _ _ d _ -> d
 #else
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index 6b0df700c2..5b6625a003 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -23,6 +23,7 @@ import CmmProcPointZ
 import CmmStackLayout
 import CmmTx
 import DFMonad
+import Module
 import FastString
 import FiniteMap
 import ForeignCall
@@ -518,8 +519,8 @@ lowerSafeForeignCall state m@(MidForeignCall (Safe infotable _) _ _ _) tail = do
     new_base <- newTemp (cmmRegType (CmmGlobal BaseReg))
     let (caller_save, caller_load) = callerSaveVolatileRegs 
     load_tso <- newTemp gcWord -- TODO FIXME NOW
-    let suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "suspendThread")))
-        resumeThread  = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "resumeThread")))
+    let suspendThread = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "suspendThread")))
+        resumeThread  = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "resumeThread")))
         suspend = mkStore (CmmReg spReg) (CmmLit (CmmBlock infotable)) <*>
                   saveThreadState <*>
                   caller_save <*>
diff --git a/compiler/cmm/CmmCPSGen.hs b/compiler/cmm/CmmCPSGen.hs
index 5d691f8e5c..a0baa51fa1 100644
--- a/compiler/cmm/CmmCPSGen.hs
+++ b/compiler/cmm/CmmCPSGen.hs
@@ -20,6 +20,7 @@ import CgInfoTbls
 import SMRep
 import ForeignCall
 
+import Module
 import Constants
 import StaticFlags
 import Unique
@@ -259,8 +260,8 @@ foreignCall uniques call results arguments =
 -- Save/restore the thread state in the TSO
 
 suspendThread, resumeThread :: CmmExpr
-suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "suspendThread")))
-resumeThread  = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "resumeThread")))
+suspendThread = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "suspendThread")))
+resumeThread  = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "resumeThread")))
 
 -- This stuff can't be done in suspendThread/resumeThread, because it
 -- refers to global registers which aren't available in the C world.
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 0783fc4ce1..c3a37b2f23 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -3,6 +3,8 @@
 -- (c) The University of Glasgow, 2004-2006
 --
 -- Parser for concrete Cmm.
+-- This doesn't just parse the Cmm file, we also do some code generation
+-- along the way for switches and foreign calls etc.
 --
 -----------------------------------------------------------------------------
 
@@ -16,7 +18,8 @@
 
 module CmmParse ( parseCmmFile ) where
 
-import CgMonad
+import CgMonad		hiding (getDynFlags)
+import CgExtCode
 import CgHeapery
 import CgUtils
 import CgProf
@@ -40,6 +43,7 @@ import SMRep
 import Lexer
 
 import ForeignCall
+import Module
 import Literal
 import Unique
 import UniqFM
@@ -54,6 +58,7 @@ import Constants
 import Outputable
 import BasicTypes
 import Bag              ( emptyBag, unitBag )
+import Var
 
 import Control.Monad
 import Data.Array
@@ -166,8 +171,9 @@ cmmtop	:: { ExtCode }
 	| cmmdata			{ $1 }
 	| decl				{ $1 } 
 	| 'CLOSURE' '(' NAME ',' NAME lits ')' ';'  
-		{ do lits <- sequence $6;
-		     staticClosure $3 $5 (map getLit lits) }
+		{% withThisPackage $ \pkg -> 
+		   do lits <- sequence $6;
+		      staticClosure pkg $3 $5 (map getLit lits) }
 
 -- The only static closures in the RTS are dummy closures like
 -- stg_END_TSO_QUEUE_closure and stg_dummy_ret.  We don't need
@@ -190,7 +196,10 @@ statics	:: { [ExtFCode [CmmStatic]] }
 -- Strings aren't used much in the RTS HC code, so it doesn't seem
 -- worth allowing inline strings.  C-- doesn't allow them anyway.
 static 	:: { ExtFCode [CmmStatic] }
-	: NAME ':'	{ return [CmmDataLabel (mkRtsDataLabel $1)] }
+	: NAME ':'	
+		{% withThisPackage $ \pkg -> 
+		   return [CmmDataLabel (mkCmmDataLabel pkg $1)] }
+
 	| type expr ';'	{ do e <- $2;
 			     return [CmmStaticLit (getLit e)] }
 	| type ';'			{ return [CmmUninitialised
@@ -235,29 +244,33 @@ cmmproc :: { ExtCode }
 		     code (emitInfoTableAndCode entry_ret_label (CmmInfo Nothing Nothing info) formals []) }
 
 	| NAME maybe_formals_without_hints maybe_gc_block maybe_frame '{' body '}'
-		{ do ((formals, gc_block, frame), stmts) <-
-			getCgStmtsEC' $ loopDecls $ do {
-		          formals <- sequence $2;
-		          gc_block <- $3;
-			  frame <- $4;
-		          $6;
-		          return (formals, gc_block, frame) }
-                     blks <- code (cgStmtsToBlocks stmts)
-		     code (emitProc (CmmInfo gc_block frame CmmNonInfoTable) (mkRtsCodeLabel $1) formals blks) }
+		{% withThisPackage $ \pkg ->
+		   do	newFunctionName $1 pkg
+		   	((formals, gc_block, frame), stmts) <-
+			 	getCgStmtsEC' $ loopDecls $ do {
+		          		formals <- sequence $2;
+		          		gc_block <- $3;
+			  		frame <- $4;
+		          		$6;
+		          		return (formals, gc_block, frame) }
+			blks <- code (cgStmtsToBlocks stmts)
+			code (emitProc (CmmInfo gc_block frame CmmNonInfoTable) (mkCmmCodeLabel pkg $1) formals blks) }
 
 info	:: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
 	: 'INFO_TABLE' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
 		-- ptrs, nptrs, closure type, description, type
-		{ do prof <- profilingInfo $11 $13
-		     return (mkRtsEntryLabel $3,
+		{% withThisPackage $ \pkg ->
+		   do prof <- profilingInfo $11 $13
+		      return (mkCmmEntryLabel pkg $3,
 			CmmInfoTable False prof (fromIntegral $9)
 				     (ThunkInfo (fromIntegral $5, fromIntegral $7) NoC_SRT),
 			[]) }
 	
 	| 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')'
 		-- ptrs, nptrs, closure type, description, type, fun type
-		{ do prof <- profilingInfo $11 $13
-		     return (mkRtsEntryLabel $3,
+		{% withThisPackage $ \pkg -> 
+		   do prof <- profilingInfo $11 $13
+		      return (mkCmmEntryLabel pkg $3,
 			CmmInfoTable False prof (fromIntegral $9)
 				     (FunInfo (fromIntegral $5, fromIntegral $7) NoC_SRT
 				      0  -- Arity zero
@@ -270,8 +283,9 @@ info	:: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
 	-- A variant with a non-zero arity (needed to write Main_main in Cmm)
 	| 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ',' INT ')'
 		-- ptrs, nptrs, closure type, description, type, fun type, arity
-		{ do prof <- profilingInfo $11 $13
-		     return (mkRtsEntryLabel $3,
+		{% withThisPackage $ \pkg ->
+		   do prof <- profilingInfo $11 $13
+		      return (mkCmmEntryLabel pkg $3,
 			CmmInfoTable False prof (fromIntegral $9)
 				     (FunInfo (fromIntegral $5, fromIntegral $7) NoC_SRT (fromIntegral $17)
 				      (ArgSpec (fromIntegral $15))
@@ -282,35 +296,39 @@ info	:: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
 	
 	| 'INFO_TABLE_CONSTR' '(' NAME ',' INT ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
 		-- ptrs, nptrs, tag, closure type, description, type
-		{ do prof <- profilingInfo $13 $15
+		{% withThisPackage $ \pkg ->
+		   do prof <- profilingInfo $13 $15
 		     -- 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 (mkRtsEntryLabel $3,
+		      desc_lit <- code $ mkStringCLit $13
+		      return (mkCmmEntryLabel pkg $3,
 			CmmInfoTable 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
-		{ do prof <- profilingInfo $9 $11
-		     return (mkRtsEntryLabel $3,
+		{% withThisPackage $ \pkg ->
+		   do prof <- profilingInfo $9 $11
+		      return (mkCmmEntryLabel pkg $3,
 			CmmInfoTable False prof (fromIntegral $7)
 				     (ThunkSelectorInfo (fromIntegral $5) NoC_SRT),
 			[]) }
 
 	| 'INFO_TABLE_RET' '(' NAME ',' INT ')'
 		-- closure type (no live regs)
-		{ do let infoLabel = mkRtsInfoLabel $3
-		     return (mkRtsRetLabel $3,
+		{% withThisPackage $ \pkg ->
+		   do let infoLabel = mkCmmInfoLabel pkg $3
+		      return (mkCmmRetLabel pkg $3,
 			CmmInfoTable False (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
 				     (ContInfo [] NoC_SRT),
 			[]) }
 
 	| 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals_without_hints0 ')'
 		-- closure type, live regs
-		{ do live <- sequence (map (liftM Just) $7)
-		     return (mkRtsRetLabel $3,
+		{% withThisPackage $ \pkg ->
+		   do live <- sequence (map (liftM Just) $7)
+		      return (mkCmmRetLabel pkg $3,
 			CmmInfoTable False (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
 			             (ContInfo live NoC_SRT),
 			live) }
@@ -322,12 +340,25 @@ body	:: { ExtCode }
 
 decl	:: { ExtCode }
 	: type names ';'		{ mapM_ (newLocal $1) $2 }
-	| 'import' names ';'		{ mapM_ newImport $2 }
+	| 'import' importNames ';'	{ mapM_ newImport $2 }
 	| 'export' names ';'		{ return () }  -- ignore exports
 
+
+-- an imported function name, with optional packageId
+importNames  
+	:: { [(Maybe PackageId, FastString)] }
+	: importName			{ [$1] }
+	| importName ',' importNames	{ $1 : $3 }		
+	
+importName
+	:: { (Maybe PackageId, FastString) }
+	: NAME				{ (Nothing, $1) }
+	| STRING NAME			{ (Just (fsToPackageId (mkFastString $1)), $2) }
+	
+	
 names 	:: { [FastString] }
-	: NAME			{ [$1] }
-	| NAME ',' names	{ $1 : $3 }
+	: NAME				{ [$1] }
+	| NAME ',' names		{ $1 : $3 }
 
 stmt	:: { ExtCode }
 	: ';'					{ nopEC }
@@ -768,110 +799,6 @@ stmtMacros = listToUFM [
 
  ]
 
--- -----------------------------------------------------------------------------
--- Our extended FCode monad.
-
--- We add a mapping from names to CmmExpr, to support local variable names in
--- the concrete C-- code.  The unique supply of the underlying FCode monad
--- is used to grab a new unique for each local variable.
-
--- In C--, a local variable can be declared anywhere within a proc,
--- and it scopes from the beginning of the proc to the end.  Hence, we have
--- to collect declarations as we parse the proc, and feed the environment
--- back in circularly (to avoid a two-pass algorithm).
-
-data Named = Var CmmExpr | Label BlockId
-type Decls = [(FastString,Named)]
-type Env   = UniqFM Named
-
-newtype ExtFCode a = EC { unEC :: Env -> Decls -> FCode (Decls, a) }
-
-type ExtCode = ExtFCode ()
-
-returnExtFC a = EC $ \e s -> return (s, a)
-thenExtFC (EC m) k = EC $ \e s -> do (s',r) <- m e s; unEC (k r) e s'
-
-instance Monad ExtFCode where
-  (>>=) = thenExtFC
-  return = returnExtFC
-
--- This function takes the variable decarations and imports and makes 
--- an environment, which is looped back into the computation.  In this
--- way, we can have embedded declarations that scope over the whole
--- procedure, and imports that scope over the entire module.
--- Discards the local declaration contained within decl'
-loopDecls :: ExtFCode a -> ExtFCode a
-loopDecls (EC fcode) =
-      EC $ \e globalDecls -> do
-	(decls', a) <- fixC (\ ~(decls,a) -> fcode (addListToUFM e (decls ++ globalDecls)) globalDecls)
-	return (globalDecls, a)
-
-getEnv :: ExtFCode Env
-getEnv = EC $ \e s -> return (s, e)
-
-addVarDecl :: FastString -> CmmExpr -> ExtCode
-addVarDecl var expr = EC $ \e s -> return ((var, Var expr):s, ())
-
-addLabel :: FastString -> BlockId -> ExtCode
-addLabel name block_id = EC $ \e s -> return ((name, Label block_id):s, ())
-
-newLocal :: CmmType -> FastString -> ExtFCode LocalReg
-newLocal ty name = do
-   u <- code newUnique
-   let reg = LocalReg u ty
-   addVarDecl name (CmmReg (CmmLocal reg))
-   return reg
-
--- Creates a foreign label in the import. CLabel's labelDynamic
--- classifies these labels as dynamic, hence the code generator emits the
--- PIC code for them.
-newImport :: FastString -> ExtFCode ()
-newImport name
-   = addVarDecl name (CmmLit (CmmLabel (mkForeignLabel name Nothing True IsFunction)))
-
-newLabel :: FastString -> ExtFCode BlockId
-newLabel name = do
-   u <- code newUnique
-   addLabel name (BlockId u)
-   return (BlockId u)
-
-lookupLabel :: FastString -> ExtFCode BlockId
-lookupLabel name = do
-  env <- getEnv
-  return $ 
-     case lookupUFM env name of
-	Just (Label l) -> l
-	_other -> BlockId (newTagUnique (getUnique name) 'L')
-
--- Unknown names are treated as if they had been 'import'ed.
--- This saves us a lot of bother in the RTS sources, at the expense of
--- deferring some errors to link time.
-lookupName :: FastString -> ExtFCode CmmExpr
-lookupName name = do
-  env <- getEnv
-  return $ 
-     case lookupUFM env name of
-	Just (Var e) -> e
-	_other -> CmmLit (CmmLabel (mkRtsCodeLabel name))
-
--- Lifting FCode computations into the ExtFCode monad:
-code :: FCode a -> ExtFCode a
-code fc = EC $ \e s -> do r <- fc; return (s, r)
-
-code2 :: (FCode (Decls,b) -> FCode ((Decls,b),c))
-	 -> ExtFCode b -> ExtFCode c
-code2 f (EC ec) = EC $ \e s -> do ((s',b),c) <- f (ec e s); return (s',c)
-
-nopEC = code nopC
-stmtEC stmt = code (stmtC stmt)
-stmtsEC stmts = code (stmtsC stmts)
-getCgStmtsEC = code2 getCgStmts'
-getCgStmtsEC' = code2 (\m -> getCgStmts' m >>= f)
-  where f ((decl, b), c) = return ((decl, b), (b, c))
-
-forkLabelledCodeEC ec = do
-  stmts <- getCgStmtsEC ec
-  code (forkCgStmts stmts)
 
 
 profilingInfo desc_str ty_str = do
@@ -884,10 +811,10 @@ profilingInfo desc_str ty_str = do
   return (ProfilingInfo lit1 lit2)
 
 
-staticClosure :: FastString -> FastString -> [CmmLit] -> ExtCode
-staticClosure cl_label info payload
-  = code $ emitDataLits (mkRtsDataLabel cl_label) lits
-  where  lits = mkStaticClosure (mkRtsInfoLabel info) dontCareCCS payload [] [] []
+staticClosure :: PackageId -> FastString -> FastString -> [CmmLit] -> ExtCode
+staticClosure pkg cl_label info payload
+  = code $ emitDataLits (mkCmmDataLabel pkg cl_label) lits
+  where  lits = mkStaticClosure (mkCmmInfoLabel pkg info) dontCareCCS payload [] [] []
 
 foreignCall
 	:: String
diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs
index 60f25d0686..8a1ae8be0c 100644
--- a/compiler/codeGen/CgCallConv.hs
+++ b/compiler/codeGen/CgCallConv.hs
@@ -45,6 +45,7 @@ import Name
 import Bitmap
 import Util
 import StaticFlags
+import Module
 import FastString
 import Outputable
 import Unique
@@ -224,7 +225,7 @@ slowArgs :: [(CgRep,CmmExpr)] -> [(CgRep,CmmExpr)]
 slowArgs [] = []
 slowArgs amodes = (NonPtrArg, mkLblExpr stg_ap_pat) : args ++ slowArgs rest
   where	(arg_pat, args, rest) = matchSlowPattern amodes
-	stg_ap_pat = mkRtsRetInfoLabel arg_pat
+	stg_ap_pat 	= mkCmmRetInfoLabel rtsPackageId arg_pat
   
 matchSlowPattern :: [(CgRep,CmmExpr)] 
 		 -> (FastString, [(CgRep,CmmExpr)], [(CgRep,CmmExpr)])
diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs
index d01b12e788..104af14754 100644
--- a/compiler/codeGen/CgClosure.lhs
+++ b/compiler/codeGen/CgClosure.lhs
@@ -560,7 +560,7 @@ link_caf cl_info _is_upd = do
 	-- so that the garbage collector can find them
 	-- This must be done *before* the info table pointer is overwritten, 
 	-- because the old info table ptr is needed for reversion
-  ; emitRtsCallWithVols (fsLit "newCAF") [CmmHinted (CmmReg nodeReg) AddrHint] [node] False
+  ; emitRtsCallWithVols rtsPackageId (fsLit "newCAF") [CmmHinted (CmmReg nodeReg) AddrHint] [node] False
 	-- node is live, so save it.
 
 	-- Overwrite the closure with a (static) indirection 
diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs
index 886e60eed4..89a4e84400 100644
--- a/compiler/codeGen/CgCon.lhs
+++ b/compiler/codeGen/CgCon.lhs
@@ -46,6 +46,7 @@ import PrelInfo
 import Outputable
 import ListSetOps
 import Util
+import Module
 import FastString
 import StaticFlags
 \end{code}
@@ -170,7 +171,7 @@ buildDynCon binder _ con [arg_amode]
   , (_, CmmLit (CmmInt val _)) <- arg_amode
   , let val_int = (fromIntegral val) :: Int
   , val_int <= mAX_INTLIKE && val_int >= mIN_INTLIKE
-  = do 	{ let intlike_lbl   = mkRtsGcPtrLabel (fsLit "stg_INTLIKE_closure")
+  = do 	{ let intlike_lbl   = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_INTLIKE_closure")
 	      offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1)
 		-- INTLIKE closures consist of a header and one word payload
 	      intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW)
@@ -181,7 +182,7 @@ buildDynCon binder _ con [arg_amode]
   , (_, CmmLit (CmmInt val _)) <- arg_amode
   , let val_int = (fromIntegral val) :: Int
   , val_int <= mAX_CHARLIKE && val_int >= mIN_CHARLIKE
-  = do 	{ let charlike_lbl   = mkRtsGcPtrLabel (fsLit "stg_CHARLIKE_closure")
+  = do 	{ let charlike_lbl   = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_CHARLIKE_closure")
 	      offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1)
 		-- CHARLIKE closures consist of a header and one word payload
 	      charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW)
diff --git a/compiler/codeGen/CgExtCode.hs b/compiler/codeGen/CgExtCode.hs
new file mode 100644
index 0000000000..03ac75e0ba
--- /dev/null
+++ b/compiler/codeGen/CgExtCode.hs
@@ -0,0 +1,231 @@
+-- | Our extended FCode monad.
+
+-- We add a mapping from names to CmmExpr, to support local variable names in
+-- the concrete C-- code.  The unique supply of the underlying FCode monad
+-- is used to grab a new unique for each local variable.
+
+-- In C--, a local variable can be declared anywhere within a proc,
+-- and it scopes from the beginning of the proc to the end.  Hence, we have
+-- to collect declarations as we parse the proc, and feed the environment
+-- back in circularly (to avoid a two-pass algorithm).
+
+module CgExtCode (
+	ExtFCode(..),
+	ExtCode,
+	Named(..), Env,
+	
+	loopDecls,
+	getEnv,
+
+	newLocal,
+	newLabel,
+	newFunctionName,
+	newImport,
+
+	lookupLabel,
+	lookupName,
+
+	code,
+	code2,
+	nopEC,
+	stmtEC,
+	stmtsEC,
+	getCgStmtsEC,
+	getCgStmtsEC',
+	forkLabelledCodeEC
+)
+
+where
+
+import CgMonad
+
+import CLabel
+import Cmm
+
+import BasicTypes
+import BlockId
+import FastString
+import Module
+import UniqFM
+import Unique
+
+
+-- | The environment contains variable definitions or blockids.
+data Named 	
+	= Var 	CmmExpr		-- ^ Holds CmmLit(CmmLabel ..) which gives the label type,
+				--	eg, RtsLabel, ForeignLabel, CmmLabel etc. 
+
+	| Fun	PackageId	-- ^ A function name from this package
+	| Label BlockId		-- ^ A blockid of some code or data.
+	
+-- | An environment of named things.
+type Env   	= UniqFM Named
+
+-- | Local declarations that are in scope during code generation.
+type Decls 	= [(FastString,Named)]
+
+-- | Does a computation in the FCode monad, with a current environment
+--	and a list of local declarations. Returns the resulting list of declarations.
+newtype ExtFCode a 	
+	= EC { unEC :: Env -> Decls -> FCode (Decls, a) }
+
+type ExtCode = ExtFCode ()
+
+returnExtFC :: a -> ExtFCode a
+returnExtFC a 	= EC $ \_ s -> return (s, a)
+
+thenExtFC :: ExtFCode a -> (a -> ExtFCode b) -> ExtFCode b
+thenExtFC (EC m) k = EC $ \e s -> do (s',r) <- m e s; unEC (k r) e s'
+
+instance Monad ExtFCode where
+  (>>=) = thenExtFC
+  return = returnExtFC
+
+
+-- | Takes the variable decarations and imports from the monad
+-- 	and makes an environment, which is looped back into the computation.  
+--	In this way, we can have embedded declarations that scope over the whole
+-- 	procedure, and imports that scope over the entire module.
+--	Discards the local declaration contained within decl'
+--
+loopDecls :: ExtFCode a -> ExtFCode a
+loopDecls (EC fcode) =
+      EC $ \e globalDecls -> do
+	(_, a) <- fixC (\ ~(decls, _) -> fcode (addListToUFM e (decls ++ globalDecls)) globalDecls)
+	return (globalDecls, a)
+
+
+-- | Get the current environment from the monad.
+getEnv :: ExtFCode Env
+getEnv 	= EC $ \e s -> return (s, e)
+
+
+-- | Add a new variable to the list of local declarations. 
+--	The CmmExpr says where the value is stored. 
+addVarDecl :: FastString -> CmmExpr -> ExtCode
+addVarDecl var expr 
+	= EC $ \_ s -> return ((var, Var expr):s, ())
+
+-- | Add a new label to the list of local declarations.
+addLabel :: FastString -> BlockId -> ExtCode
+addLabel name block_id 
+	= EC $ \_ s -> return ((name, Label block_id):s, ())
+
+
+-- | Create a fresh local variable of a given type.
+newLocal 
+	:: CmmType 		-- ^ data type
+	-> FastString 		-- ^ name of variable
+	-> ExtFCode LocalReg	-- ^ register holding the value
+	
+newLocal ty name = do
+   u <- code newUnique
+   let reg = LocalReg u ty
+   addVarDecl name (CmmReg (CmmLocal reg))
+   return reg
+
+
+-- | Allocate a fresh label.
+newLabel :: FastString -> ExtFCode BlockId
+newLabel name = do
+   u <- code newUnique
+   addLabel name (BlockId u)
+   return (BlockId u)
+
+
+-- | Add add a local function to the environment.
+newFunctionName 
+	:: FastString	-- ^ name of the function 
+	-> PackageId 	-- ^ package of the current module
+	-> ExtCode
+	
+newFunctionName name pkg
+	= EC $ \_ s -> return ((name, Fun pkg):s, ())
+	
+	
+-- | Add an imported foreign label to the list of local declarations.
+--	If this is done at the start of the module the declaration will scope
+--	over the whole module.
+--	CLabel's labelDynamic classifies these labels as dynamic, hence the
+--	code generator emits PIC code for them.
+newImport :: (Maybe PackageId, FastString) -> ExtFCode ()
+newImport (Nothing, name)
+   = addVarDecl name (CmmLit (CmmLabel (mkForeignLabel name Nothing True IsFunction)))
+
+newImport (Just pkg, name)
+   = addVarDecl name (CmmLit (CmmLabel (mkCmmCodeLabel pkg name)))
+
+-- | Lookup the BlockId bound to the label with this name.
+--	If one hasn't been bound yet, create a fresh one based on the 
+--	Unique of the name.
+lookupLabel :: FastString -> ExtFCode BlockId
+lookupLabel name = do
+  env <- getEnv
+  return $ 
+     case lookupUFM env name of
+	Just (Label l) 	-> l
+	_other 		-> BlockId (newTagUnique (getUnique name) 'L')
+
+
+-- | Lookup the location of a named variable.
+--	Unknown names are treated as if they had been 'import'ed from the runtime system.
+-- 	This saves us a lot of bother in the RTS sources, at the expense of
+-- 	deferring some errors to link time.
+lookupName :: FastString -> ExtFCode CmmExpr
+lookupName name = do
+  env    <- getEnv
+  return $ 
+     case lookupUFM env name of
+	Just (Var e) 	-> e
+	Just (Fun pkg)	-> CmmLit (CmmLabel (mkCmmCodeLabel pkg          name))
+	_other 		-> CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId name))
+
+
+-- | Lift an FCode computation into the ExtFCode monad
+code :: FCode a -> ExtFCode a
+code fc = EC $ \_ s -> do 
+		r <- fc
+ 		return (s, r)
+
+
+code2 :: (FCode (Decls,b) -> FCode ((Decls,b),c)) -> ExtFCode b -> ExtFCode c
+code2 f (EC ec) 
+	= EC $ \e s -> do 
+		((s', _),c) <- f (ec e s)
+		return (s',c)
+
+
+-- | Do nothing in the ExtFCode monad.
+nopEC :: ExtFCode ()
+nopEC = code nopC
+
+
+-- | Accumulate a CmmStmt into the monad state.
+stmtEC :: CmmStmt -> ExtFCode () 
+stmtEC stmt = code (stmtC stmt)
+
+
+-- | Accumulate some CmmStmts into the monad state.
+stmtsEC :: [CmmStmt] -> ExtFCode ()
+stmtsEC stmts = code (stmtsC stmts)
+
+
+-- | Get the generated statements out of the monad state.
+getCgStmtsEC :: ExtFCode a -> ExtFCode CgStmts
+getCgStmtsEC = code2 getCgStmts'
+
+
+-- | Get the generated statements, and the return value out of the monad state.
+getCgStmtsEC' :: ExtFCode a -> ExtFCode (a, CgStmts)
+getCgStmtsEC' = code2 (\m -> getCgStmts' m >>= f)
+  where f ((decl, b), c) = return ((decl, b), (b, c))
+
+
+-- | Emit a chunk of code outside the instruction stream, 
+--	and return its block id. 
+forkLabelledCodeEC :: ExtFCode a -> ExtFCode BlockId
+forkLabelledCodeEC ec = do
+  stmts <- getCgStmtsEC ec
+  code (forkCgStmts stmts)
+
+
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index 593de4e829..809e10b875 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -33,6 +33,7 @@ import ClosureInfo
 import Constants
 import StaticFlags
 import Outputable
+import Module
 import FastString
 import BasicTypes
 
@@ -144,8 +145,8 @@ emitForeignCall' safety results target args vols _srt ret
     emitLoadThreadState
 
 suspendThread, resumeThread :: CmmExpr
-suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "suspendThread")))
-resumeThread  = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "resumeThread")))
+suspendThread = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "suspendThread")))
+resumeThread  = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "resumeThread")))
 
 
 -- we might need to load arguments into temporaries before
diff --git a/compiler/codeGen/CgHeapery.lhs b/compiler/codeGen/CgHeapery.lhs
index 8d4f7f232a..65f94d1fa2 100644
--- a/compiler/codeGen/CgHeapery.lhs
+++ b/compiler/codeGen/CgHeapery.lhs
@@ -41,6 +41,7 @@ import DataCon
 import TyCon
 import CostCentre
 import Util
+import Module
 import Constants
 import Outputable
 import FastString
@@ -346,7 +347,7 @@ altHeapCheck alt_type code
 	; setRealHp hpHw
 	; code }
   where
-    rts_label PolyAlt = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "stg_gc_unpt_r1")))
+    rts_label PolyAlt = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_unpt_r1")))
       	-- Do *not* enter R1 after a heap check in
 	-- a polymorphic case.  It might be a function
 	-- and the entry code for a function (currently)
@@ -360,14 +361,14 @@ altHeapCheck alt_type code
     rts_label (PrimAlt tc)
       = CmmLit $ CmmLabel $ 
 	case primRepToCgRep (tyConPrimRep tc) of
-	  VoidArg   -> mkRtsCodeLabel (fsLit "stg_gc_noregs")
-	  FloatArg  -> mkRtsCodeLabel (fsLit "stg_gc_f1")
-	  DoubleArg -> mkRtsCodeLabel (fsLit "stg_gc_d1")
-	  LongArg   -> mkRtsCodeLabel (fsLit "stg_gc_l1")
+	  VoidArg   -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_noregs")
+	  FloatArg  -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_f1")
+	  DoubleArg -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_d1")
+	  LongArg   -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_l1")
 				-- R1 is boxed but unlifted: 
-	  PtrArg    -> mkRtsCodeLabel (fsLit "stg_gc_unpt_r1")
+	  PtrArg    -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_unpt_r1")
 				-- R1 is unboxed:
-	  NonPtrArg -> mkRtsCodeLabel (fsLit "stg_gc_unbx_r1")
+	  NonPtrArg -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_unbx_r1")
 
     rts_label (UbxTupAlt _) = panic "altHeapCheck"
 \end{code}
@@ -405,7 +406,7 @@ unbxTupleHeapCheck regs ptrs nptrs fail_code code
     assign_liveness = CmmAssign (CmmGlobal (VanillaReg 9 VNonGcPtr)) 	-- Ho ho ho!
 				(CmmLit (mkWordCLit liveness))
     liveness 	    = mkRegLiveness regs ptrs nptrs
-    rts_label	    = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "stg_gc_ut")))
+    rts_label	    = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_ut")))
 
 \end{code}
 
@@ -514,7 +515,7 @@ stkChkNodePoints bytes
   = do_checks' bytes (CmmLit (mkIntCLit 0)) True False noStmts stg_gc_enter1
 
 stg_gc_gen :: CmmExpr
-stg_gc_gen = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "stg_gc_gen")))
+stg_gc_gen = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_gen")))
 stg_gc_enter1 :: CmmExpr
 stg_gc_enter1 = CmmReg (CmmGlobal GCEnter1)
 \end{code}
diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs
index af6b1ed311..83d2b72747 100644
--- a/compiler/codeGen/CgMonad.lhs
+++ b/compiler/codeGen/CgMonad.lhs
@@ -47,7 +47,7 @@ module CgMonad (
 	Sequel(..), -- ToDo: unabstract?
 
 	-- ideally we wouldn't export these, but some other modules access internal state
-	getState, setState, getInfoDown, getDynFlags, getThisPackage,
+	getState, setState, getInfoDown, getDynFlags, getThisPackage, 
 
 	-- more localised access to monad state	
 	getStkUsage, setStkUsage,
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs
index d80fb718f5..7f100e283b 100644
--- a/compiler/codeGen/CgPrimOp.hs
+++ b/compiler/codeGen/CgPrimOp.hs
@@ -23,6 +23,7 @@ import CLabel
 import CmmUtils
 import PrimOp
 import SMRep
+import Module
 import Constants
 import Outputable
 import FastString
@@ -122,7 +123,7 @@ emitPrimOp [res] ParOp [arg] live
         NoC_SRT -- No SRT b/c we do PlayRisky
         CmmMayReturn
   where
-	newspark = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "newSpark")))
+	newspark = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark")))
 
 emitPrimOp [res] ReadMutVarOp [mutv] _
    = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize gcWord))
diff --git a/compiler/codeGen/CgProf.hs b/compiler/codeGen/CgProf.hs
index c984e0d16a..7491334c21 100644
--- a/compiler/codeGen/CgProf.hs
+++ b/compiler/codeGen/CgProf.hs
@@ -47,6 +47,7 @@ import CostCentre
 import StgSyn
 import StaticFlags
 import FastString
+import Module
 import Constants	-- Lots of field offsets
 import Outputable
 
@@ -65,7 +66,7 @@ curCCS = CmmLoad curCCSAddr bWord
 
 -- Address of current CCS variable, for storing into
 curCCSAddr :: CmmExpr
-curCCSAddr = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCCS")))
+curCCSAddr = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCCS")))
 
 mkCCostCentre :: CostCentre -> CmmLit
 mkCCostCentre cc = CmmLabel (mkCCLabel cc)
@@ -260,7 +261,7 @@ enterCostCentreThunk closure =
     stmtC $ CmmStore curCCSAddr (costCentreFrom closure)
 
 enter_ccs_fun :: CmmExpr -> Code
-enter_ccs_fun stack = emitRtsCall (fsLit "EnterFunCCS") [CmmHinted stack AddrHint] False
+enter_ccs_fun stack = emitRtsCall rtsPackageId (fsLit "EnterFunCCS") [CmmHinted stack AddrHint] False
 			-- ToDo: vols
 
 enter_ccs_fsub :: Code
@@ -273,7 +274,7 @@ enter_ccs_fsub = enteringPAP 0
 -- entering via a PAP.
 enteringPAP :: Integer -> Code
 enteringPAP n
-  = stmtC (CmmStore (CmmLit (CmmLabel (mkRtsDataLabel (fsLit "entering_PAP"))))
+  = stmtC (CmmStore (CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "entering_PAP"))))
 		(CmmLit (CmmInt n cIntWidth)))
 
 ifProfiling :: Code -> Code
@@ -389,12 +390,12 @@ emitRegisterCCS ccs = do
 
 
 cC_LIST, cC_ID :: CmmExpr
-cC_LIST = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CC_LIST")))
-cC_ID   = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CC_ID")))
+cC_LIST = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CC_LIST")))
+cC_ID   = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CC_ID")))
 
 cCS_LIST, cCS_ID :: CmmExpr
-cCS_LIST = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCS_LIST")))
-cCS_ID   = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCS_ID")))
+cCS_LIST = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCS_LIST")))
+cCS_ID   = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCS_ID")))
 
 -- ---------------------------------------------------------------------------
 -- Set the current cost centre stack
@@ -413,6 +414,7 @@ emitSetCCC cc
 pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> Code
 pushCostCentre result ccs cc
   = emitRtsCallWithResult result AddrHint
+	rtsPackageId 
 	(fsLit "PushCostCentre") [CmmHinted ccs AddrHint, 
 				 CmmHinted (CmmLit (mkCCostCentre cc)) AddrHint]
         False
@@ -479,7 +481,7 @@ ldvEnter cl_ptr
 
 loadEra :: CmmExpr 
 loadEra = CmmMachOp (MO_UU_Conv cIntWidth wordWidth)
-	  [CmmLoad (mkLblExpr (mkRtsDataLabel $ fsLit("era"))) cInt]
+	  [CmmLoad (mkLblExpr (mkCmmDataLabel rtsPackageId $ fsLit("era"))) cInt]
 
 ldvWord :: CmmExpr -> CmmExpr
 -- Takes the address of a closure, and returns 
diff --git a/compiler/codeGen/CgTicky.hs b/compiler/codeGen/CgTicky.hs
index 5a885e05a7..7e8c5ca964 100644
--- a/compiler/codeGen/CgTicky.hs
+++ b/compiler/codeGen/CgTicky.hs
@@ -183,7 +183,7 @@ registerTickyCtr ctr_lbl
 	, CmmStore (CmmLit (cmmLabelOffB ctr_lbl 
 				oFFSET_StgEntCounter_registeredp))
 		   (CmmLit (mkIntCLit 1)) ]
-    ticky_entry_ctrs = mkLblExpr (mkRtsDataLabel (fsLit "ticky_entry_ctrs"))
+    ticky_entry_ctrs = mkLblExpr (mkCmmDataLabel rtsPackageId (fsLit "ticky_entry_ctrs"))
 
 tickyReturnOldCon, tickyReturnNewCon :: Arity -> Code
 tickyReturnOldCon arity 
@@ -292,9 +292,9 @@ tickyAllocHeap hp
 			(CmmLit (cmmLabelOffB ticky_ctr 
 				oFFSET_StgEntCounter_allocs)) hp,
 		-- Bump ALLOC_HEAP_ctr
-	    addToMemLbl cLongWidth (mkRtsDataLabel $ fsLit "ALLOC_HEAP_ctr") 1,
+	    addToMemLbl cLongWidth (mkCmmDataLabel rtsPackageId $ fsLit "ALLOC_HEAP_ctr") 1,
   		-- Bump ALLOC_HEAP_tot
-	    addToMemLbl cLongWidth (mkRtsDataLabel $ fsLit "ALLOC_HEAP_tot") hp] }
+	    addToMemLbl cLongWidth (mkCmmDataLabel rtsPackageId $ fsLit "ALLOC_HEAP_tot") hp] }
 
 -- -----------------------------------------------------------------------------
 -- Ticky utils
@@ -309,7 +309,7 @@ addToMemLbl rep lbl n = addToMem rep (CmmLit (CmmLabel lbl)) n
 
 -- All the ticky-ticky counters are declared "unsigned long" in C
 bumpTickyCounter :: FastString -> Code
-bumpTickyCounter lbl = bumpTickyCounter' (cmmLabelOffB (mkRtsDataLabel lbl) 0)
+bumpTickyCounter lbl = bumpTickyCounter' (cmmLabelOffB (mkCmmDataLabel rtsPackageId lbl) 0)
 
 bumpTickyCounter' :: CmmLit -> Code
 -- krc: note that we're incrementing the _entry_count_ field of the ticky counter
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 0a545432d6..75f6b19292 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -67,6 +67,7 @@ import CmmUtils
 import ForeignCall
 import ClosureInfo
 import StgSyn (SRT(..))
+import Module
 import Literal
 import Digraph
 import ListSetOps
@@ -331,28 +332,39 @@ emitIfThenElse cond then_part else_part
        ; labelC join_id
        }
 
-emitRtsCall :: FastString -> [CmmHinted CmmExpr] -> Bool -> Code
-emitRtsCall fun args safe = emitRtsCall' [] fun args Nothing safe
+
+-- | Emit code to call a Cmm function.
+emitRtsCall 
+   :: PackageId 		-- ^ package the function is in
+   -> FastString 		-- ^ name of function
+   -> [CmmHinted CmmExpr] 	-- ^ function args
+   -> Bool 			-- ^ whether this is a safe call
+   -> Code			-- ^ cmm code
+
+emitRtsCall pkg fun args safe = emitRtsCall' [] pkg fun args Nothing safe
    -- The 'Nothing' says "save all global registers"
 
-emitRtsCallWithVols :: FastString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code
-emitRtsCallWithVols fun args vols safe
-   = emitRtsCall' [] fun args (Just vols) safe
+emitRtsCallWithVols :: PackageId -> FastString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code
+emitRtsCallWithVols pkg fun args vols safe
+   = emitRtsCall' [] pkg fun args (Just vols) safe
 
-emitRtsCallWithResult :: LocalReg -> ForeignHint -> FastString
-	-> [CmmHinted CmmExpr] -> Bool -> Code
-emitRtsCallWithResult res hint fun args safe
-   = emitRtsCall' [CmmHinted res hint] fun args Nothing safe
+emitRtsCallWithResult 
+   :: LocalReg -> ForeignHint 
+   -> PackageId -> FastString
+   -> [CmmHinted CmmExpr] -> Bool -> Code
+emitRtsCallWithResult res hint pkg fun args safe
+   = emitRtsCall' [CmmHinted res hint] pkg fun args Nothing safe
 
 -- Make a call to an RTS C procedure
 emitRtsCall'
    :: [CmmHinted LocalReg]
+   -> PackageId
    -> FastString
    -> [CmmHinted CmmExpr]
    -> Maybe [GlobalReg]
    -> Bool -- True <=> CmmSafe call
    -> Code
-emitRtsCall' res fun args vols safe = do
+emitRtsCall' res pkg fun args vols safe = do
   safety <- if safe
             then getSRTInfo >>= (return . CmmSafe)
             else return CmmUnsafe
@@ -362,7 +374,7 @@ emitRtsCall' res fun args vols safe = do
   where
     (caller_save, caller_load) = callerSaveVolatileRegs vols
     target   = CmmCallee fun_expr CCallConv
-    fun_expr = mkLblExpr (mkRtsCodeLabel fun)
+    fun_expr = mkLblExpr (mkCmmCodeLabel pkg fun)
 
 -----------------------------------------------------------------------------
 --
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index e7d5444761..5af8f341ad 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -494,8 +494,8 @@ emitBlackHoleCode is_single_entry
   | otherwise = 
 	nopC
   where
-    bh_lbl | is_single_entry = mkRtsDataLabel (fsLit "stg_SE_BLACKHOLE_info")
-	   | otherwise	     = mkRtsDataLabel (fsLit "stg_BLACKHOLE_info")
+    bh_lbl | is_single_entry = mkCmmDataLabel rtsPackageId (fsLit "stg_SE_BLACKHOLE_info")
+	   | otherwise	     = mkCmmDataLabel rtsPackageId (fsLit "stg_BLACKHOLE_info")
 
 	-- If we wanted to do eager blackholing with slop filling,
 	-- we'd need to do it at the *end* of a basic block, otherwise
@@ -605,7 +605,7 @@ link_caf cl_info _is_upd = do
 	-- so that the garbage collector can find them
 	-- This must be done *before* the info table pointer is overwritten, 
 	-- because the old info table ptr is needed for reversion
-  ; emitRtsCallWithVols (fsLit "newCAF") [(CmmReg nodeReg,AddrHint)] [node] False
+  ; emitRtsCallWithVols rtsPackageId (fsLit "newCAF") [(CmmReg nodeReg,AddrHint)] [node] False
 	-- node is live, so save it.
 
 	-- Overwrite the closure with a (static) indirection 
diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs
index cfac231eda..452a352bab 100644
--- a/compiler/codeGen/StgCmmCon.hs
+++ b/compiler/codeGen/StgCmmCon.hs
@@ -30,6 +30,7 @@ import CLabel
 import MkZipCfgCmm (CmmAGraph, mkNop)
 import SMRep
 import CostCentre
+import Module
 import Constants
 import DataCon
 import FastString
@@ -153,7 +154,7 @@ buildDynCon binder _cc con [arg]
   , StgLitArg (MachInt val) <- arg
   , val <= fromIntegral mAX_INTLIKE 	-- Comparisons at type Integer!
   , val >= fromIntegral mIN_INTLIKE	-- ...ditto...
-  = do 	{ let intlike_lbl   = mkRtsGcPtrLabel (fsLit "stg_INTLIKE_closure")
+  = do 	{ let intlike_lbl   = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_INTLIKE_closure")
 	      val_int = fromIntegral val :: Int
 	      offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1)
 		-- INTLIKE closures consist of a header and one word payload
@@ -166,7 +167,7 @@ buildDynCon binder _cc con [arg]
   , let val_int = ord val :: Int
   , val_int <= mAX_CHARLIKE
   , val_int >= mIN_CHARLIKE
-  = do 	{ let charlike_lbl   = mkRtsGcPtrLabel (fsLit "stg_CHARLIKE_closure")
+  = do 	{ let charlike_lbl   = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_CHARLIKE_closure")
 	      offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1)
 		-- CHARLIKE closures consist of a header and one word payload
 	      charlike_amode = cmmLabelOffW charlike_lbl offsetW
diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs
index 8d23ade2c7..d7eafe3dba 100644
--- a/compiler/codeGen/StgCmmHeap.hs
+++ b/compiler/codeGen/StgCmmHeap.hs
@@ -40,6 +40,7 @@ import DataCon
 import TyCon
 import CostCentre
 import Outputable
+import Module
 import FastString( mkFastString, FastString, fsLit )
 import Constants
 
@@ -349,8 +350,9 @@ entryHeapCheck fun arity args code
     gc_call updfr_sz
         | arity == 0 = mkJumpGC (CmmReg (CmmGlobal GCEnter1)) arg_exprs updfr_sz
         | otherwise  = case gc_lbl args' of
-                         Just lbl -> mkJumpGC (CmmLit (CmmLabel (mkRtsCodeLabel lbl)))
-                                              arg_exprs updfr_sz
+                         Just _lbl -> panic "StgCmmHeap.entryHeapCheck: gc_lbl not finished"
+				     -- mkJumpGC (CmmLit (CmmLabel (mkRtsCodeLabel lbl)))
+                                     --         arg_exprs updfr_sz
                          Nothing  -> mkCall generic_gc (GC, GC) [] [] updfr_sz
 
     gc_lbl :: [LocalReg] -> Maybe FastString
@@ -388,8 +390,9 @@ altHeapCheck regs code
 	| null regs = mkCall generic_gc (GC, GC) [] [] updfr_sz
 
 	| Just gc_lbl <- rts_label regs	-- Canned call
-	= mkCall    (CmmLit (CmmLabel (mkRtsCodeLabel gc_lbl))) (GC, GC)
-		    regs (map (CmmReg . CmmLocal) regs) updfr_sz
+	= panic "StgCmmHeap.altHeapCheck: rts_label not finished"
+		-- mkCall    (CmmLit (CmmLabel (mkRtsCodeLabel gc_lbl))) (GC, GC)
+		--	    regs (map (CmmReg . CmmLocal) regs) updfr_sz
 	| otherwise		-- No canned call, and non-empty live vars
 	= mkCall generic_gc (GC, GC) [] [] updfr_sz
 
@@ -413,7 +416,7 @@ altHeapCheck regs code
 
 
 generic_gc :: CmmExpr	-- The generic GC procedure; no params, no resuls
-generic_gc = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "stg_gc_noregs")))
+generic_gc = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_noregs")))
 -- JD: TEMPORARY -- UNTIL THOSE FUNCTIONS EXIST...
 -- generic_gc = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_fun")))
 
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index f0a2798bf1..e5ff8f73ff 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -28,6 +28,7 @@ import CmmUtils
 import PrimOp
 import SMRep
 import Constants
+import Module
 import FastString
 import Outputable
 
@@ -201,7 +202,7 @@ emitPrimOp [res] ParOp [arg]
 	-- later, we might want to inline it.
     emitCCall
 	[(res,NoHint)]
-    	(CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "newSpark"))))
+    	(CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark"))))
 	[(CmmReg (CmmGlobal BaseReg), AddrHint), (arg,AddrHint)] 
 
 emitPrimOp [res] ReadMutVarOp [mutv]
diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs
index aab9824199..944729f287 100644
--- a/compiler/codeGen/StgCmmProf.hs
+++ b/compiler/codeGen/StgCmmProf.hs
@@ -49,6 +49,7 @@ import CostCentre
 import StgSyn
 import StaticFlags
 import FastString
+import Module
 import Constants	-- Lots of field offsets
 import Outputable
 
@@ -73,7 +74,7 @@ curCCS = CmmLoad curCCSAddr ccsType
 
 -- Address of current CCS variable, for storing into
 curCCSAddr :: CmmExpr
-curCCSAddr = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCCS")))
+curCCSAddr = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCCS")))
 
 mkCCostCentre :: CostCentre -> CmmLit
 mkCCostCentre cc = CmmLabel (mkCCLabel cc)
@@ -315,7 +316,7 @@ enterCostCentreThunk closure =
     emit $ mkStore curCCSAddr (costCentreFrom closure)
 
 enter_ccs_fun :: CmmExpr -> FCode ()
-enter_ccs_fun stack = emitRtsCall (fsLit "EnterFunCCS") [(stack,AddrHint)] False
+enter_ccs_fun stack = emitRtsCall rtsPackageId (fsLit "EnterFunCCS") [(stack,AddrHint)] False
 			-- ToDo: vols
 
 enter_ccs_fsub :: FCode ()
@@ -328,7 +329,7 @@ enter_ccs_fsub = enteringPAP 0
 -- entering via a PAP.
 enteringPAP :: Integer -> FCode ()
 enteringPAP n
-  = emit (mkStore (CmmLit (CmmLabel (mkRtsDataLabel (fsLit "entering_PAP"))))
+  = emit (mkStore (CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "entering_PAP"))))
 		  (CmmLit (CmmInt n cIntWidth)))
 
 ifProfiling :: FCode () -> FCode ()
@@ -447,12 +448,12 @@ mkRegisterCCS ccs
 
 
 cC_LIST, cC_ID :: CmmExpr
-cC_LIST = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CC_LIST")))
-cC_ID   = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CC_ID")))
+cC_LIST = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CC_LIST")))
+cC_ID   = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CC_ID")))
 
 cCS_LIST, cCS_ID :: CmmExpr
-cCS_LIST = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCS_LIST")))
-cCS_ID   = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCS_ID")))
+cCS_LIST = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCS_LIST")))
+cCS_ID   = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCS_ID")))
 
 -- ---------------------------------------------------------------------------
 -- Set the current cost centre stack
@@ -471,6 +472,7 @@ emitSetCCC cc
 pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> FCode ()
 pushCostCentre result ccs cc
   = emitRtsCallWithResult result AddrHint
+	rtsPackageId
 	(fsLit "PushCostCentre") [(ccs,AddrHint), 
 				(CmmLit (mkCCostCentre cc), AddrHint)]
         False
@@ -538,7 +540,7 @@ ldvEnter cl_ptr
 
 loadEra :: CmmExpr 
 loadEra = CmmMachOp (MO_UU_Conv cIntWidth wordWidth)
-	  [CmmLoad (mkLblExpr (mkRtsDataLabel (fsLit "era"))) cInt]
+	  [CmmLoad (mkLblExpr (mkCmmDataLabel rtsPackageId (fsLit "era"))) cInt]
 
 ldvWord :: CmmExpr -> CmmExpr
 -- Takes the address of a closure, and returns 
diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs
index 579544b055..3fa579b80c 100644
--- a/compiler/codeGen/StgCmmTicky.hs
+++ b/compiler/codeGen/StgCmmTicky.hs
@@ -187,7 +187,7 @@ registerTickyCtr ctr_lbl
 	, mkStore (CmmLit (cmmLabelOffB ctr_lbl 
 				oFFSET_StgEntCounter_registeredp))
 		   (CmmLit (mkIntCLit 1)) ]
-    ticky_entry_ctrs = mkLblExpr (mkRtsDataLabel (fsLit "ticky_entry_ctrs"))
+    ticky_entry_ctrs = mkLblExpr (mkCmmDataLabel rtsPackageId (fsLit "ticky_entry_ctrs"))
 
 tickyReturnOldCon, tickyReturnNewCon :: Arity -> FCode ()
 tickyReturnOldCon arity 
@@ -317,9 +317,9 @@ tickyAllocHeap hp
 			(CmmLit (cmmLabelOffB ticky_ctr 
 				oFFSET_StgEntCounter_allocs)) hp,
 		-- Bump ALLOC_HEAP_ctr
-	    addToMemLbl cLong (mkRtsDataLabel (fsLit "ALLOC_HEAP_ctr")) 1,
+	    addToMemLbl cLong (mkCmmDataLabel rtsPackageId (fsLit "ALLOC_HEAP_ctr")) 1,
 		-- Bump ALLOC_HEAP_tot
-	    addToMemLbl cLong (mkRtsDataLabel (fsLit "ALLOC_HEAP_tot")) hp] }
+	    addToMemLbl cLong (mkCmmDataLabel rtsPackageId (fsLit "ALLOC_HEAP_tot")) hp] }
 
 -- -----------------------------------------------------------------------------
 -- Ticky utils
@@ -331,7 +331,7 @@ ifTicky code = do dflags <- getDynFlags
 
 -- All the ticky-ticky counters are declared "unsigned long" in C
 bumpTickyCounter :: FastString -> FCode ()
-bumpTickyCounter lbl = bumpTickyCounter' (cmmLabelOffB (mkRtsDataLabel lbl) 0)
+bumpTickyCounter lbl = bumpTickyCounter' (cmmLabelOffB (mkCmmDataLabel rtsPackageId lbl) 0)
 
 bumpTickyCounter' :: CmmLit -> FCode ()
 -- krc: note that we're incrementing the _entry_count_ field of the ticky counter
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index bf452c4651..a9532e5eff 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -62,6 +62,7 @@ import TyCon
 import Constants
 import SMRep
 import StgSyn	( SRT(..) )
+import Module
 import Literal
 import Digraph
 import ListSetOps
@@ -283,28 +284,29 @@ tagToClosure tycon tag
 --
 -------------------------------------------------------------------------
 
-emitRtsCall :: FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
-emitRtsCall fun args safe = emitRtsCall' [] fun args Nothing safe
+emitRtsCall :: PackageId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
+emitRtsCall pkg fun args safe = emitRtsCall' [] pkg fun args Nothing safe
    -- The 'Nothing' says "save all global registers"
 
-emitRtsCallWithVols :: FastString -> [(CmmExpr,ForeignHint)] -> [GlobalReg] -> Bool -> FCode ()
-emitRtsCallWithVols fun args vols safe
-   = emitRtsCall' [] fun args (Just vols) safe
+emitRtsCallWithVols :: PackageId -> FastString -> [(CmmExpr,ForeignHint)] -> [GlobalReg] -> Bool -> FCode ()
+emitRtsCallWithVols pkg fun args vols safe
+   = emitRtsCall' [] pkg fun args (Just vols) safe
 
-emitRtsCallWithResult :: LocalReg -> ForeignHint -> FastString
+emitRtsCallWithResult :: LocalReg -> ForeignHint -> PackageId -> FastString
 	-> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
-emitRtsCallWithResult res hint fun args safe
-   = emitRtsCall' [(res,hint)] fun args Nothing safe
+emitRtsCallWithResult res hint pkg fun args safe
+   = emitRtsCall' [(res,hint)] pkg fun args Nothing safe
 
 -- Make a call to an RTS C procedure
 emitRtsCall'
    :: [(LocalReg,ForeignHint)]
+   -> PackageId
    -> FastString
    -> [(CmmExpr,ForeignHint)]
    -> Maybe [GlobalReg]
    -> Bool -- True <=> CmmSafe call
    -> FCode ()
-emitRtsCall' res fun args _vols safe
+emitRtsCall' res pkg fun args _vols safe
   = --error "emitRtsCall'"
     do { updfr_off <- getUpdFrameOff
        ; emit caller_save
@@ -320,7 +322,7 @@ emitRtsCall' res fun args _vols safe
     (args', arg_hints) = unzip args
     (res',  res_hints) = unzip res
     (caller_save, caller_load) = callerSaveVolatileRegs
-    fun_expr = mkLblExpr (mkRtsCodeLabel fun)
+    fun_expr = mkLblExpr (mkCmmCodeLabel pkg fun)
 
 
 -----------------------------------------------------------------------------
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 1037a1a589..bbdd2a1cce 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -46,9 +46,9 @@
 module Lexer (
    Token(..), lexer, pragState, mkPState, PState(..),
    P(..), ParseResult(..), getSrcLoc, 
-   getPState,
+   getPState, getDynFlags, withThisPackage,
    failLocMsgP, failSpanMsgP, srcParseFail,
-   getMessages,
+   getMessages, 
    popContext, pushCurrentContext, setLastToken, setSrcLoc,
    getLexState, popLexState, pushLexState,
    extension, standaloneDerivingEnabled, bangPatEnabled,
@@ -64,6 +64,7 @@ import FastString
 import SrcLoc
 import UniqFM
 import DynFlags
+import Module
 import Ctype
 import Util		( readRational )
 
@@ -1515,6 +1516,14 @@ failSpanMsgP span msg = P $ \_ -> PFailed span msg
 getPState :: P PState
 getPState = P $ \s -> POk s s
 
+getDynFlags :: P DynFlags
+getDynFlags = P $ \s -> POk s (dflags s)
+
+withThisPackage :: (PackageId -> a) -> P a
+withThisPackage f
+ = do	pkg	<- liftM thisPackage getDynFlags
+	return	$ f pkg
+
 extension :: (Int -> Bool) -> P Bool
 extension p = P $ \s -> POk s (p $! extsBitmap s)