Commit eab7055a authored by wolfgang's avatar wolfgang

[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.
parent e0bc615f
......@@ -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}
......
......@@ -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
......
......@@ -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");
......
......@@ -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)
......
......@@ -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);
}
......
......@@ -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.
}
/*
......
......@@ -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:
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment