From: sof <unknown>
Date: Fri, 22 Apr 2005 16:01:54 +0000 (+0000)
Subject: [project @ 2005-04-22 16:01:53 by sof]
X-Git-Tag: Initial_conversion_from_CVS_complete~698
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=a584b4ffc67402ed3086f7acb8ff46f50dc787cc;p=ghc-hetmet.git

[project @ 2005-04-22 16:01:53 by sof]
Until the GHCi linker is made capable of handling .ctors sections in
PEi object files, stick with __stginits. Being a bit sloppy by
using 'mingw32_HOST_OS' to test for this.
---

diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index 3e346f6..a649ebd 100644
--- a/ghc/compiler/codeGen/CodeGen.lhs
+++ b/ghc/compiler/codeGen/CodeGen.lhs
@@ -87,9 +87,14 @@ codeGen dflags this_mod type_env foreign_stubs imported_mods
 		; cmm_tycons <- mapM cgTyCon data_tycons
 		; cmm_init   <- getCmm (mkModuleInit dflags way cost_centre_info 
 					     this_mod mb_main_mod
-				  	     imported_mods)
+				  	     foreign_stubs imported_mods)
 		; return (cmm_binds ++ concat cmm_tycons
-                        ++ if opt_SccProfilingOn then [cmm_init] else [])
+                        ++ 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
@@ -151,9 +156,10 @@ mkModuleInit
 	-> CollectedCCs         -- cost centre info
 	-> Module
 	-> Maybe String		-- Just m ==> we have flag: -main-is Foo.baz 
+	-> ForeignStubs
 	-> [Module]
 	-> Code
-mkModuleInit dflags way cost_centre_info this_mod mb_main_mod imported_mods
+mkModuleInit dflags way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mods
   = do	{ 	
 
 	-- Allocate the static boolean that records if this
@@ -212,6 +218,9 @@ mkModuleInit dflags way cost_centre_info this_mod mb_main_mod imported_mods
 	  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)
@@ -227,6 +236,17 @@ registerModuleImport dflags way mod
   = stmtsC [ CmmAssign spReg (cmmRegOffW spReg (-1))
 	   , CmmStore (CmmReg spReg) (mkLblExpr (mkModuleInitLabel dflags mod way)) ]
 
+-----------------------
+registerForeignExports :: ForeignStubs -> Code
+registerForeignExports NoStubs 
+  = nopC
+registerForeignExports (ForeignStubs _ _ _ fe_bndrs)
+  = mapM_ mk_export_register fe_bndrs
+  where
+	mk_export_register bndr
+	  = emitRtsCall SLIT("getStablePtr") 
+		[ (CmmLit (CmmLabel (mkLocalClosureLabel (idName bndr))), 
+		   PtrHint) ]
 \end{code}
 
 
diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs
index 03f0777..b909c57 100644
--- a/ghc/compiler/deSugar/DsForeign.lhs
+++ b/ghc/compiler/deSugar/DsForeign.lhs
@@ -530,10 +530,21 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
           Nothing -> empty
           Just hs_fn -> text "extern StgClosure " <> ppr hs_fn <> text "_closure" <> semi
 
+   -- the only reason for making the mingw32 (anything targetting PE, really) stick
+   -- out here is that the GHCi linker isn't capable of handling .ctors sections
+  useStaticConstructors 
+#if defined(mingw32_HOST_OS)
+	= False
+#else
+	= True
+#endif  
+
   initialiser
      = case maybe_target of
           Nothing -> empty
-          Just hs_fn ->
+          Just hs_fn 
+	   | not useStaticConstructors -> empty
+	   | otherwise ->
             vcat
              [ text "static void stginit_export_" <> ppr hs_fn
                   <> text "() __attribute__((constructor));"
diff --git a/ghc/rts/Main.c b/ghc/rts/Main.c
index 182f589..0b937df 100644
--- a/ghc/rts/Main.c
+++ b/ghc/rts/Main.c
@@ -49,7 +49,8 @@ int main(int argc, char *argv[])
     SchedulerStatus status;
     /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */
 
-#if defined(PROFILING)
+#if defined(PROFILING) || defined(mingw32_HOST_OS)
+    /* mingw32 and PROFILING (still) define __stginits in .text */
     startupHaskell(argc,argv,__stginit_ZCMain);
 #else
     startupHaskell(argc,argv,NULL);