[project @ 2005-04-15 05:29:48 by wolfgang]

Initialise foreign exports from GNU C __attribute__((constructor)) functions
in the stub C file, rather than from __stginit_ functions.
For non-profiling ways, leave out __stginit_ alltogether.

ghc/compiler/codeGen/CodeGen.lhs

@@ -87,8 +87,9 @@ 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
-				  	     foreign_stubs imported_mods)
-		; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init]) 
+				  	     imported_mods)
+		; return (cmm_binds ++ concat cmm_tycons
+                        ++ if opt_SccProfilingOn then [cmm_init] else [])
 		}
 		-- Put datatype_stuff after code_stuff, because the
 		-- datatype closure table (for enumeration types) to
@@ -150,10 +151,9 @@ 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 foreign_stubs imported_mods
+mkModuleInit dflags way cost_centre_info this_mod mb_main_mod imported_mods
   = do	{ 	
 
 	-- Allocate the static boolean that records if this
@@ -212,7 +212,6 @@ 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
-	; registerForeignExports foreign_stubs
 	; initCostCentres cost_centre_info
 	; mapCs (registerModuleImport dflags way) 
 		(imported_mods++extra_imported_mods)
@@ -228,17 +227,6 @@ 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}
 
 

ghc/compiler/deSugar/DsForeign.lhs

@@ -530,6 +530,19 @@ 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
 
+  initialiser
+     = case maybe_target of
+          Nothing -> empty
+          Just hs_fn ->
+            vcat
+             [ text "static void stginit_export_" <> ppr hs_fn
+                  <> text "() __attribute__((constructor));"
+             , text "static void stginit_export_" <> ppr hs_fn <> text "()"
+             , braces (text "getStablePtr"
+                <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure")
+                <> semi)
+             ]
+
   -- finally, the whole darn thing
   c_bits =
     space $$
@@ -560,7 +573,8 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
      ,   if res_hty_is_unit then empty
             else text "return cret;"
      , rbrace
-     ]
+     ] $$
+    initialiser
 
 -- NB. the calculation here isn't strictly speaking correct.
 -- We have a primitive Haskell type (eg. Int#, Double#), and

ghc/driver/split/ghc-split.lprl

@@ -68,6 +68,18 @@ sub split_asm_file {
 	  || &tidy_up_and_die(1,"$Pgm:Failed writing ${Tmp_prefix}__${octr}.s\n");
     }
 
+    # Make sure that we still have some output when the input file is empty
+    if ( $octr == 0 ) {
+        $octr = 1;
+	$ofname = "${Tmp_prefix}__${octr}.s";
+	open(OUTF, "> $ofname") || die "$Pgm: can't open output file: $ofname\n";
+
+	print OUTF $prologue_stuff;
+
+	close(OUTF)
+	  || &tidy_up_and_die(1,"$Pgm:Failed writing ${Tmp_prefix}__${octr}.s\n");
+    }
+
     $NoOfSplitFiles = $octr;
 
     close(TMPI) || &tidy_up_and_die(1,"Failed reading $asm_file\n");

ghc/rts/Main.c

@@ -49,7 +49,11 @@ int main(int argc, char *argv[])
     SchedulerStatus status;
     /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */
 
+#if defined(PROFILING)
     startupHaskell(argc,argv,__stginit_ZCMain);
+#else
+    startupHaskell(argc,argv,NULL);
+#endif
 
     /* Register this thread as a task, so we can get timing stats about it */
 #if defined(RTS_SUPPORTS_THREADS)

ghc/rts/RtsStartup.c

@@ -237,7 +237,8 @@ void
 startupHaskell(int argc, char *argv[], void (*init_root)(void))
 {
     hs_init(&argc, &argv);
-    hs_add_root(init_root);
+    if(init_root)
+        hs_add_root(init_root);
 }
 
 

ghc/rts/Stable.c

@@ -137,6 +137,9 @@ initStablePtrTable(void)
     // Nothing to do:
     // the table will be allocated the first time makeStablePtr is
     // called, and we want the table to persist through multiple inits.
+    //
+    // Also, getStablePtr is now called from __attribute__((constructor))
+    // functions, so initialising things here wouldn't work anyway.
 }
 
 /*

ghc/rts/package.conf.in

@@ -99,7 +99,6 @@ ld-options:
          , "-u", "_GHCziIOBase_BlockedIndefinitely_closure"
          , "-u", "_GHCziIOBase_Deadlock_closure"
          , "-u", "_GHCziWeak_runFinalizzerBatch_closure"
-         , "-u", "___stginit_Prelude"
 #else
            "-u", "GHCziBase_Izh_static_info"
          , "-u", "GHCziBase_Czh_static_info"
@@ -133,7 +132,6 @@ ld-options:
          , "-u", "GHCziIOBase_BlockedIndefinitely_closure"
          , "-u", "GHCziIOBase_Deadlock_closure"
          , "-u", "GHCziWeak_runFinalizzerBatch_closure"
-         , "-u", "__stginit_Prelude"
 #endif
 
 framework-dirs: