[project @ 2005-04-28 16:05:54 by simonpj]

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

diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index 056fb1e..abe78f4 100644 (file)
--- a/ghc/compiler/codeGen/CodeGen.lhs
+++ b/ghc/compiler/codeGen/CodeGen.lhs
@@ -19,8 +19,6 @@ module CodeGen ( codeGen ) where
 
 #include "HsVersions.h"
 
-import DriverState     ( v_Build_tag, v_MainModIs )
-
 -- Kludge (??) so that CgExpr is reached via at least one non-SOURCE
 -- import.  Before, that wasn't the case, and CM therefore didn't 
 -- bother to compile it.
@@ -41,15 +39,15 @@ import MachOp               ( wordRep, MachHint(..) )
 
 import StgSyn
 import PrelNames       ( gHC_PRIM, rOOT_MAIN, mAIN, pREL_TOP_HANDLER )
-import CmdLineOpts     ( DynFlags, DynFlag(..), opt_EnsureSplittableC,
-                         opt_SccProfilingOn )
+import DynFlags                ( DynFlags(..), DynFlag(..), dopt )
+import StaticFlags     ( opt_SccProfilingOn )
 
 import HscTypes                ( ForeignStubs(..), TypeEnv, typeEnvTyCons )
 import CostCentre       ( CollectedCCs )
 import Id               ( Id, idName, setIdName )
 import Name            ( nameSrcLoc, nameOccName, nameUnique, isInternalName, mkExternalName )
 import OccName         ( mkLocalOcc )
-import TyCon            ( isDataTyCon )
+import TyCon            ( TyCon )
 import Module          ( Module, mkModule )
 import ErrUtils                ( dumpIfSet_dyn, showPass )
 import Panic           ( assertPanic )
@@ -57,29 +55,24 @@ import Panic                ( assertPanic )
 #ifdef DEBUG
 import Outputable
 #endif
-
-import DATA_IOREF      ( readIORef )
 \end{code}
 
 \begin{code}
 codeGen :: DynFlags
        -> Module
-       -> TypeEnv
+       -> [TyCon]
        -> ForeignStubs
        -> [Module]             -- directly-imported modules
        -> CollectedCCs         -- (Local/global) cost-centres needing declaring/registering.
        -> [(StgBinding,[(Id,[Id])])]   -- Bindings to convert, with SRTs
        -> IO [Cmm]             -- Output
 
-codeGen dflags this_mod type_env foreign_stubs imported_mods 
+codeGen dflags this_mod data_tycons foreign_stubs imported_mods 
        cost_centre_info stg_binds
   = do 
   { showPass dflags "CodeGen"
-  ; way <- readIORef v_Build_tag
-  ; mb_main_mod <- readIORef v_MainModIs
-
-  ; let     tycons     = typeEnvTyCons type_env
-           data_tycons = filter isDataTyCon tycons
+  ; let way = buildTag dflags
+        mb_main_mod = mainModIs dflags
 
 -- Why?
 --   ; mapM_ (\x -> seq x (return ())) data_tycons
@@ -90,7 +83,13 @@ codeGen dflags this_mod type_env foreign_stubs imported_mods
                ; cmm_init   <- getCmm (mkModuleInit dflags way cost_centre_info 
                                             this_mod mb_main_mod
                                             foreign_stubs imported_mods)
-               ; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init]) 
+               ; return (cmm_binds ++ concat cmm_tycons
+                        ++ if opt_SccProfilingOn 
+#if defined(mingw32_HOST_OS)
+                             || True
+#endif
+                           then [cmm_init] 
+                           else [])
                }
                -- Put datatype_stuff after code_stuff, because the
                -- datatype closure table (for enumeration types) to
@@ -137,7 +136,7 @@ codeGen dflags this_mod type_env foreign_stubs imported_mods
    startupHaskell() must supply the name of the init function for the "top"
    module in the program, and we don't want to require that this name
    has the version and way info appended to it.
-   -------------------------------------------------------------------------- */
+   --------------------------------------------------------------------------  */
 
 We initialise the module tree by keeping a work-stack, 
        * pointed to by Sp
@@ -214,7 +213,9 @@ mkModuleInit dflags way cost_centre_info this_mod mb_main_mod foreign_stubs impo
          stmtC (CmmStore (mkLblExpr moduleRegdLabel) (CmmLit (mkIntCLit 1)))
 
                -- Now do local stuff
+#if defined(mingw32_HOST_OS)
        ; registerForeignExports foreign_stubs
+#endif
        ; initCostCentres cost_centre_info
        ; mapCs (registerModuleImport dflags way) 
                (imported_mods++extra_imported_mods)
@@ -283,7 +284,7 @@ variable.
 \begin{code}
 cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code
 cgTopBinding dflags (StgNonRec id rhs, srts)
-  = do { id' <- maybeExternaliseId id
+  = do { id' <- maybeExternaliseId dflags id
        ; mapM_ (mkSRT dflags [id']) srts
        ; (id,info) <- cgTopRhs id' rhs
        ; addBindC id info      -- Add the *un-externalised* Id to the envt,
@@ -292,10 +293,10 @@ cgTopBinding dflags (StgNonRec id rhs, srts)
 
 cgTopBinding dflags (StgRec pairs, srts)
   = do { let (bndrs, rhss) = unzip pairs
-       ; bndrs' <- mapFCs maybeExternaliseId bndrs
+       ; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
        ; let pairs' = zip bndrs' rhss
        ; mapM_ (mkSRT dflags bndrs')  srts
-       ; new_binds <- fixC (\ new_binds -> do 
+       ; _new_binds <- fixC (\ new_binds -> do 
                { addBindsC new_binds
                ; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
        ; nopC }
@@ -344,9 +345,9 @@ If we're splitting the object, we need to externalise all the top-level names
 which refers to this name).
 
 \begin{code}
-maybeExternaliseId :: Id -> FCode Id
-maybeExternaliseId id
-  | opt_EnsureSplittableC,     -- Externalise the name for -split-objs
+maybeExternaliseId :: DynFlags -> Id -> FCode Id
+maybeExternaliseId dflags id
+  | dopt Opt_SplitObjs dflags,         -- Externalise the name for -split-objs
     isInternalName name = do { mod <- moduleName
                             ; returnFC (setIdName id (externalise mod)) }
   | otherwise          = returnFC id