[project @ 2002-08-16 13:20:36 by simonmar]

[ghc-hetmet.git] / ghc / compiler / codeGen / CodeGen.lhs

diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index 477790d..a8ce811 100644 (file)
--- a/ghc/compiler/codeGen/CodeGen.lhs
+++ b/ghc/compiler/codeGen/CodeGen.lhs
@@ -24,10 +24,13 @@ module CodeGen ( codeGen ) where
 -- bother to compile it.
 import CgExpr           ( {-NOTHING!-} )       -- DO NOT DELETE THIS IMPORT
 
+import DriverState     ( v_Build_tag )
 import StgSyn
 import CgMonad
 import AbsCSyn
-import CLabel          ( CLabel, mkSRTLabel, mkClosureLabel, mkModuleInitLabel )
+import PrelNames       ( gHC_PRIM )
+import CLabel          ( CLabel, mkSRTLabel, mkClosureLabel, 
+                         mkPlainModuleInitLabel, mkModuleInitLabel )
 
 import PprAbsC         ( dumpRealC )
 import AbsCUtils       ( mkAbstractCs, flattenAbsC )
@@ -45,7 +48,7 @@ import OccName                ( mkLocalOcc )
 import Module           ( Module )
 import PrimRep         ( PrimRep(..) )
 import TyCon            ( TyCon, isDataTyCon )
-import BasicTypes      ( TopLevelFlag(..) )
+import BasicTypes      ( TopLevelFlag(..), Version )
 import UniqSupply      ( mkSplitUniqSupply )
 import ErrUtils                ( dumpIfSet_dyn, showPass )
 import Panic           ( assertPanic )
@@ -53,6 +56,8 @@ import Panic          ( assertPanic )
 #ifdef DEBUG
 import Outputable
 #endif
+
+import IOExts          ( readIORef )
 \end{code}
 
 \begin{code}
@@ -67,29 +72,32 @@ codeGen :: DynFlags
 
 codeGen dflags mod_name imported_modules cost_centre_info fe_binders
        tycons stg_binds
-  = do { showPass dflags "CodeGen"
-       ; fl_uniqs <- mkSplitUniqSupply 'f'
-       ; dumpIfSet_dyn dflags Opt_D_dump_absC "Abstract C" (dumpRealC abstractC)
-       ; let flat_abstractC = flattenAbsC fl_uniqs abstractC
-       ; return flat_abstractC
-       }
-  where
-    data_tycons    = filter isDataTyCon tycons
-    cinfo          = MkCompInfo mod_name
-
-    datatype_stuff = genStaticConBits cinfo data_tycons
-    code_stuff     = initC cinfo (mapCs cgTopBinding stg_binds)
-    init_stuff     = mkModuleInit fe_binders mod_name imported_modules 
-                                         cost_centre_info
-
-    abstractC = mkAbstractCs [ maybeSplitCode,
-                              init_stuff, 
-                              code_stuff,
-                              datatype_stuff]
-       -- Put datatype_stuff after code_stuff, because the
-       -- datatype closure table (for enumeration types)
-       -- to (say) PrelBase_True_closure, which is defined in code_stuff
-
+  = do 
+       showPass dflags "CodeGen"
+       fl_uniqs <- mkSplitUniqSupply 'f'
+       way <- readIORef v_Build_tag
+
+       let
+           data_tycons    = filter isDataTyCon tycons
+           cinfo          = MkCompInfo mod_name
+
+           datatype_stuff = genStaticConBits cinfo data_tycons
+           code_stuff     = initC cinfo (mapCs cgTopBinding stg_binds)
+           init_stuff     = mkModuleInit fe_binders mod_name way
+                               imported_modules cost_centre_info
+
+           abstractC = mkAbstractCs [ maybeSplitCode,
+                                      init_stuff, 
+                                      code_stuff,
+                                      datatype_stuff]
+               -- Put datatype_stuff after code_stuff, because the
+               -- datatype closure table (for enumeration types) to
+               -- (say) PrelBase_True_closure, which is defined in
+               -- code_stuff
+
+       dumpIfSet_dyn dflags Opt_D_dump_absC "Abstract C" (dumpRealC abstractC)
+
+       return $! flattenAbsC fl_uniqs abstractC
 \end{code}
 
 %************************************************************************
@@ -102,10 +110,11 @@ codeGen dflags mod_name imported_modules cost_centre_info fe_binders
 mkModuleInit 
        :: [Id]                 -- foreign exported functions
        -> Module               -- module name
+       -> String               -- the "way"
        -> [Module]             -- import names
        -> CollectedCCs         -- cost centre info
        -> AbstractC
-mkModuleInit fe_binders mod imps cost_centre_info
+mkModuleInit fe_binders mod way imps cost_centre_info
   = let
        register_fes = 
           map (\f -> CMacroStmt REGISTER_FOREIGN_EXPORT [f]) fe_labels
@@ -115,16 +124,19 @@ mkModuleInit fe_binders mod imps cost_centre_info
 
        (cc_decls, cc_regs) = mkCostCentreStuff cost_centre_info
 
-       mk_import_register imp =
-           CMacroStmt REGISTER_IMPORT [
-               CLbl (mkModuleInitLabel imp) AddrRep
-           ]
+       -- we don't want/need to init GHC.Prim, so filter it out
+       mk_import_register imp
+           | imp == gHC_PRIM = AbsCNop
+           | otherwise = CMacroStmt REGISTER_IMPORT [
+                               CLbl (mkModuleInitLabel imp way) AddrRep
+                         ]
 
        register_imports = map mk_import_register imps
     in
     mkAbstractCs [
        cc_decls,
-        CModuleInitBlock (mkModuleInitLabel mod)
+        CModuleInitBlock (mkPlainModuleInitLabel mod)
+                        (mkModuleInitLabel mod way)
                         (mkAbstractCs (register_fes ++
                                        cc_regs :
                                        register_imports))