From: wolfgang Date: Fri, 15 Apr 2005 05:29:49 +0000 (+0000) Subject: [project @ 2005-04-15 05:29:48 by wolfgang] X-Git-Tag: Initial_conversion_from_CVS_complete~736 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=eab7055a9512b150681156f146ee76ad8f67b72f;p=ghc-hetmet.git [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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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: