[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.

diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index 0c8e314..3e346f6 100644 (file)
--- a/ghc/compiler/codeGen/CodeGen.lhs
+++ b/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}
 
 

diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs
index e861ef3..03f0777 100644 (file)
--- a/ghc/compiler/deSugar/DsForeign.lhs
+++ b/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

diff --git a/ghc/driver/split/ghc-split.lprl b/ghc/driver/split/ghc-split.lprl
index 1f8acfa..f2fcf03 100644 (file)
--- a/ghc/driver/split/ghc-split.lprl
+++ b/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");

diff --git a/ghc/rts/Main.c b/ghc/rts/Main.c
index c6d4170..182f589 100644 (file)
--- a/ghc/rts/Main.c
+++ b/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)

diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c
index 98e1459..887b6f7 100644 (file)
--- a/ghc/rts/RtsStartup.c
+++ b/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);
 }
 
 

diff --git a/ghc/rts/Stable.c b/ghc/rts/Stable.c
index 30d17c0..a2829c6 100644 (file)
--- a/ghc/rts/Stable.c
+++ b/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.
 }
 
 /*

diff --git a/ghc/rts/package.conf.in b/ghc/rts/package.conf.in
index 6666863..eedbfc1 100644 (file)
--- a/ghc/rts/package.conf.in
+++ b/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: