X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCodeGen.lhs;h=2c4ea5cfaed9442a4d668ab9514fe6c4e74e05c0;hb=311b1cdfc9b1c311cc53482c461c18cba8885b2a;hp=48c0cbfbb9ecada36ba23a9b07cdd01cd80e417f;hpb=6bca92c3f75df35fcb2ec23d56107783373da7e6;p=ghc-hetmet.git

diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs
index 48c0cbf..2c4ea5c 100644
--- a/compiler/codeGen/CodeGen.lhs
+++ b/compiler/codeGen/CodeGen.lhs
@@ -1,19 +1,15 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-\section[CodeGen]{@CodeGen@: main module of the code generator}
+
+The Code Generator
 
 This module says how things get going at the top level.
 
 @codeGen@ is the interface to the outside world.  The \tr{cgTop*}
 functions drive the mangling of top-level bindings.
 
-%************************************************************************
-%*									*
-\subsection[codeGen-outside-interface]{The code generator's offering to the world}
-%*									*
-%************************************************************************
-
 \begin{code}
 module CodeGen ( codeGen ) where
 
@@ -25,42 +21,39 @@ module CodeGen ( codeGen ) where
 import CgExpr           ( {-NOTHING!-} )	-- DO NOT DELETE THIS IMPORT
 import CgProf
 import CgMonad
-import CgBindery	( CgIdInfo, addBindC, addBindsC, getCgIdInfo,
-			  cgIdInfoId )
-import CgClosure	( cgTopRhsClosure )
-import CgCon		( cgTopRhsCon, cgTyCon )
-import CgUtils		( cmmRegOffW, emitRODataLits, cmmNeWord )
+import CgBindery
+import CgClosure
+import CgCon
+import CgUtils
 
 import CLabel
 import Cmm
-import CmmUtils		( zeroCLit, mkIntCLit, mkLblExpr )
-import PprCmm		( pprCmms )
-import MachOp		( wordRep )
+import CmmUtils
+import PprCmm
+import MachOp
 
 import StgSyn
-import PrelNames	( gHC_PRIM, rOOT_MAIN, pREL_TOP_HANDLER )
-import Packages		( HomeModules )
-import DynFlags		( DynFlags(..), DynFlag(..), dopt )
-import StaticFlags	( opt_SccProfilingOn )
-
-import HscTypes		( ForeignStubs(..) )
-import CostCentre       ( CollectedCCs )
-import Id               ( Id, idName, setIdName )
-import Name		( nameSrcLoc, nameOccName, nameUnique, isInternalName, mkExternalName )
-import OccName		( mkLocalOcc )
-import TyCon            ( TyCon )
-import Module		( Module )
-import ErrUtils		( dumpIfSet_dyn, showPass )
-import Panic		( assertPanic )
+import PrelNames
+import DynFlags
+import StaticFlags
+
+import PackageConfig
+import HscTypes
+import CostCentre
+import Id
+import Name
+import OccName
+import TyCon
+import Module
+import ErrUtils
 
 #ifdef DEBUG
-import Outputable
+import Panic
 #endif
 \end{code}
 
 \begin{code}
 codeGen :: DynFlags
-	-> HomeModules
 	-> Module
 	-> [TyCon]
 	-> ForeignStubs
@@ -69,7 +62,7 @@ codeGen :: DynFlags
 	-> [(StgBinding,[(Id,[Id])])]	-- Bindings to convert, with SRTs
 	-> IO [Cmm]		-- Output
 
-codeGen dflags hmods this_mod data_tycons foreign_stubs imported_mods 
+codeGen dflags this_mod data_tycons foreign_stubs imported_mods 
 	cost_centre_info stg_binds
   = do	
   { showPass dflags "CodeGen"
@@ -79,10 +72,10 @@ codeGen dflags hmods this_mod data_tycons foreign_stubs imported_mods
 -- Why?
 --   ; mapM_ (\x -> seq x (return ())) data_tycons
 
-  ; code_stuff <- initC dflags hmods this_mod $ do 
-		{ cmm_binds  <- mapM (getCmm . cgTopBinding dflags hmods) stg_binds
+  ; code_stuff <- initC dflags this_mod $ do 
+		{ cmm_binds  <- mapM (getCmm . cgTopBinding dflags) stg_binds
 		; cmm_tycons <- mapM cgTyCon data_tycons
-		; cmm_init   <- getCmm (mkModuleInit dflags hmods way cost_centre_info 
+		; cmm_init   <- getCmm (mkModuleInit dflags way cost_centre_info 
 					     this_mod main_mod
 				  	     foreign_stubs imported_mods)
 		; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init])
@@ -143,7 +136,6 @@ We initialise the module tree by keeping a work-stack,
 \begin{code}
 mkModuleInit 
 	:: DynFlags
-	-> HomeModules
 	-> String		-- the "way"
 	-> CollectedCCs         -- cost centre info
 	-> Module
@@ -151,7 +143,7 @@ mkModuleInit
 	-> ForeignStubs
 	-> [Module]
 	-> Code
-mkModuleInit dflags hmods way cost_centre_info this_mod main_mod foreign_stubs imported_mods
+mkModuleInit dflags way cost_centre_info this_mod main_mod foreign_stubs imported_mods
   = do	{ 	
         if opt_SccProfilingOn
             then do { -- Allocate the static boolean that records if this
@@ -184,9 +176,11 @@ mkModuleInit dflags hmods way cost_centre_info this_mod main_mod foreign_stubs i
 		(emitSimpleProc plain_main_init_lbl jump_to_init)
     }
   where
-    plain_init_lbl = mkPlainModuleInitLabel hmods this_mod
-    real_init_lbl  = mkModuleInitLabel hmods this_mod way
-    plain_main_init_lbl = mkPlainModuleInitLabel hmods rOOT_MAIN
+    this_pkg = thisPackage dflags
+
+    plain_init_lbl = mkPlainModuleInitLabel this_pkg this_mod
+    real_init_lbl  = mkModuleInitLabel this_pkg this_mod way
+    plain_main_init_lbl = mkPlainModuleInitLabel this_pkg rOOT_MAIN
 
     jump_to_init = stmtC (CmmJump (mkLblExpr real_init_lbl) [])
 
@@ -195,7 +189,7 @@ mkModuleInit dflags hmods way cost_centre_info this_mod main_mod foreign_stubs i
     -- Main refers to GHC.TopHandler.runIO, so make sure we call the
     -- init function for GHC.TopHandler.
     extra_imported_mods
-	| this_mod == main_mod = [pREL_TOP_HANDLER]
+	| this_mod == main_mod = [gHC_TOP_HANDLER]
 	| otherwise	       = []
 
     mod_init_code = do
@@ -204,7 +198,7 @@ mkModuleInit dflags hmods way cost_centre_info this_mod main_mod foreign_stubs i
 
 		-- Now do local stuff
 	; initCostCentres cost_centre_info
-	; mapCs (registerModuleImport hmods way) 
+	; mapCs (registerModuleImport this_pkg way) 
 		(imported_mods++extra_imported_mods)
 	} 
 
@@ -214,13 +208,13 @@ mkModuleInit dflags hmods way cost_centre_info this_mod main_mod foreign_stubs i
                       , CmmJump (CmmLoad (cmmRegOffW spReg (-1)) wordRep) [] ]
 
 -----------------------
-registerModuleImport :: HomeModules -> String -> Module -> Code
-registerModuleImport hmods way mod 
+registerModuleImport :: PackageId -> String -> Module -> Code
+registerModuleImport this_pkg way mod 
   | mod == gHC_PRIM
   = nopC 
   | otherwise 	-- Push the init procedure onto the work stack
   = stmtsC [ CmmAssign spReg (cmmRegOffW spReg (-1))
-	   , CmmStore (CmmReg spReg) (mkLblExpr (mkModuleInitLabel hmods mod way)) ]
+	   , CmmStore (CmmReg spReg) (mkLblExpr (mkModuleInitLabel this_pkg mod way)) ]
 \end{code}
 
 
@@ -261,32 +255,32 @@ style, with the increasing static environment being plumbed as a state
 variable.
 
 \begin{code}
-cgTopBinding :: DynFlags -> HomeModules -> (StgBinding,[(Id,[Id])]) -> Code
-cgTopBinding dflags hmods (StgNonRec id rhs, srts)
+cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code
+cgTopBinding dflags (StgNonRec id rhs, srts)
   = do	{ id' <- maybeExternaliseId dflags id
-	; mapM_ (mkSRT hmods [id']) srts
+	; mapM_ (mkSRT (thisPackage dflags) [id']) srts
 	; (id,info) <- cgTopRhs id' rhs
 	; addBindC id info 	-- Add the *un-externalised* Id to the envt,
 				-- so we find it when we look up occurrences
 	}
 
-cgTopBinding dflags hmods (StgRec pairs, srts)
+cgTopBinding dflags (StgRec pairs, srts)
   = do	{ let (bndrs, rhss) = unzip pairs
 	; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
 	; let pairs' = zip bndrs' rhss
-	; mapM_ (mkSRT hmods bndrs')  srts
+	; mapM_ (mkSRT (thisPackage dflags) bndrs')  srts
 	; _new_binds <- fixC (\ new_binds -> do 
 		{ addBindsC new_binds
 		; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
 	; nopC }
 
-mkSRT :: HomeModules -> [Id] -> (Id,[Id]) -> Code
-mkSRT hmods these (id,[])  = nopC
-mkSRT hmods these (id,ids)
+mkSRT :: PackageId -> [Id] -> (Id,[Id]) -> Code
+mkSRT this_pkg these (id,[])  = nopC
+mkSRT this_pkg these (id,ids)
   = do	{ ids <- mapFCs remap ids
 	; id  <- remap id
 	; emitRODataLits (mkSRTLabel (idName id)) 
-		       (map (CmmLabel . mkClosureLabel hmods . idName) ids)
+		       (map (CmmLabel . mkClosureLabel this_pkg . idName) ids)
 	}
   where
 	-- Sigh, better map all the ids against the environment in 
@@ -327,11 +321,11 @@ which refers to this name).
 maybeExternaliseId :: DynFlags -> Id -> FCode Id
 maybeExternaliseId dflags id
   | dopt Opt_SplitObjs dflags, 	-- Externalise the name for -split-objs
-    isInternalName name = do { mod <- moduleName
+    isInternalName name = do { mod <- getModuleName
 			     ; returnFC (setIdName id (externalise mod)) }
   | otherwise		= returnFC id
   where
-    externalise mod = mkExternalName uniq mod new_occ Nothing loc
+    externalise mod = mkExternalName uniq mod new_occ loc
     name    = idName id
     uniq    = nameUnique name
     new_occ = mkLocalOcc uniq (nameOccName name)