summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ghc/compiler/codeGen/CodeGen.lhs20
-rw-r--r--ghc/compiler/deSugar/DsForeign.lhs16
-rw-r--r--ghc/driver/split/ghc-split.lprl12
-rw-r--r--ghc/rts/Main.c4
-rw-r--r--ghc/rts/RtsStartup.c3
-rw-r--r--ghc/rts/Stable.c3
-rw-r--r--ghc/rts/package.conf.in2
7 files changed, 40 insertions, 20 deletions
diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index 0c8e314fcc..3e346f6d15 100644
--- 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 e861ef3fb0..03f07779ea 100644
--- 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 1f8acfaad9..f2fcf03d28 100644
--- 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 c6d41702a8..182f589af0 100644
--- 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 98e1459573..887b6f77fa 100644
--- 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 30d17c04fb..a2829c6341 100644
--- 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 6666863dd0..eedbfc14dd 100644
--- 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: