diff options
| -rw-r--r-- | compiler/main/SysTools/ExtraObj.hs | 11 | ||||
| -rw-r--r-- | includes/Rts.h | 1 | ||||
| -rw-r--r-- | includes/RtsAPI.h | 9 | ||||
| -rw-r--r-- | includes/rts/SimpleMain.h | 38 | ||||
| -rw-r--r-- | rts/RtsMain.c | 32 | ||||
| -rw-r--r-- | rts/rts.cabal.in | 1 |
6 files changed, 79 insertions, 13 deletions
diff --git a/compiler/main/SysTools/ExtraObj.hs b/compiler/main/SysTools/ExtraObj.hs index c930389c95..b62c5d258e 100644 --- a/compiler/main/SysTools/ExtraObj.hs +++ b/compiler/main/SysTools/ExtraObj.hs @@ -93,18 +93,18 @@ mkExtraObjToLinkIntoBinary dflags = do _ -> exeMain exeMain = vcat [ - text "#include \"Rts.h\"", + text "#include \"rts/SimpleMain.h\"", text "extern StgClosure ZCMain_main_closure;", text "int main(int argc, char *argv[])", char '{', - text " RtsConfig __conf = defaultRtsConfig;", + text " RtsSimpleConfig __conf;", text " __conf.rts_opts_enabled = " <> text (show (rtsOptsEnabled dflags)) <> semi, text " __conf.rts_opts_suggestions = " <> text (if rtsOptsSuggestions dflags then "true" else "false") <> semi, - text "__conf.keep_cafs = " + text " __conf.keep_cafs = " <> text (if gopt Opt_KeepCAFs dflags then "true" else "false") <> semi, @@ -112,8 +112,9 @@ mkExtraObjToLinkIntoBinary dflags = do Nothing -> Outputable.empty Just opts -> text " __conf.rts_opts= " <> text (show opts) <> semi, - text " __conf.rts_hs_main = true;", - text " return hs_main(argc,argv,&ZCMain_main_closure,__conf);", + -- N.B. this does not return; hs_main() rather exit()s. + text " hs_simple_main(argc,argv,&ZCMain_main_closure,__conf);", + text " return 0;", char '}', char '\n' -- final newline, to keep gcc happy ] diff --git a/includes/Rts.h b/includes/Rts.h index 0fae58956d..b0654d7fa8 100644 --- a/includes/Rts.h +++ b/includes/Rts.h @@ -218,6 +218,7 @@ void _assertFail(const char *filename, unsigned int linenum) #include "rts/Utils.h" #include "rts/PrimFloat.h" #include "rts/Main.h" +#include "rts/SimpleMain.h" #include "rts/Profiling.h" #include "rts/StaticPtrTable.h" #include "rts/Libdw.h" diff --git a/includes/RtsAPI.h b/includes/RtsAPI.h index a9afab8a5c..5f75e54381 100644 --- a/includes/RtsAPI.h +++ b/includes/RtsAPI.h @@ -16,6 +16,7 @@ extern "C" { #endif #include "HsFFI.h" +#include "rts/SimpleMain.h" // For RtsOptsEnabledEnum #include "rts/Time.h" #include "rts/EventLogWriter.h" @@ -51,14 +52,6 @@ typedef struct CapabilityPublic_ { RTS configuration settings, for passing to hs_init_ghc() ------------------------------------------------------------------------- */ -typedef enum { - RtsOptsNone, // +RTS causes an error - RtsOptsIgnore, // Ignore command line arguments - RtsOptsIgnoreAll, // Ignore command line and Environment arguments - RtsOptsSafeOnly, // safe RTS options allowed; others cause an error - RtsOptsAll // all RTS options allowed - } RtsOptsEnabledEnum; - struct GCDetails_; // The RtsConfig struct is passed (by value) to hs_init_ghc(). The diff --git a/includes/rts/SimpleMain.h b/includes/rts/SimpleMain.h new file mode 100644 index 0000000000..5d7fdca826 --- /dev/null +++ b/includes/rts/SimpleMain.h @@ -0,0 +1,38 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2009 + * + * Reduced-functionality entry point for standalone Haskell programs. + * + * See Note [Simple main] in RtsMain.c. + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include <stdbool.h> + +struct StgClosure_; + +typedef enum { + RtsOptsNone, // +RTS causes an error + RtsOptsIgnore, // Ignore command line arguments + RtsOptsIgnoreAll, // Ignore command line and Environment arguments + RtsOptsSafeOnly, // safe RTS options allowed; others cause an error + RtsOptsAll // all RTS options allowed + } RtsOptsEnabledEnum; + +struct RtsSimpleConfig { + RtsOptsEnabledEnum rts_opts_enabled; + bool rts_opts_suggestions; + bool keep_cafs; + const char *rts_opts; +}; + +#if defined(__GNUC__) +// N.B. Don't use GNU_ATTRIBUTE to avoid dependency on Stg.h. +__attribute__((noreturn)) +#endif +void hs_simple_main (int argc, char *argv[], + struct StgClosure_ *main_closure, + struct RtsSimpleConfig rts_config); + diff --git a/rts/RtsMain.c b/rts/RtsMain.c index 21b8577cca..badf118eed 100644 --- a/rts/RtsMain.c +++ b/rts/RtsMain.c @@ -99,4 +99,36 @@ int hs_main ( int argc, char *argv[], // program args shutdownHaskellAndExit(exit_status, 0 /* !fastExit */); // No code beyond this point. Dead code elimination will remove it } + +/* + * Note [Simple main] + * ~~~~~~~~~~~~~~~~~~ + * + * When GHC compiles a Haskell executable it generates a small C stub which + * calls into the runtime system. Previously this stub would include Rts.h, + * pulling in dozens upon dozens of GHC and system header files. Compiling the + * ten line stub would consequently produce nearly 6000 lstat calls and take + * several dozen milliseconds. In a build with lots of executables this can + * really add up. + * + * Consequently we now expose hs_simple_main, which is declared in + * includes/SimpleMain.h and can be compiled with a minimal set of headers. + * + * N.B. this does not return; hs_main() rather exit()s. + */ + +void hs_simple_main (int argc, + char *argv[], + struct StgClosure_ *main_closure, + struct RtsSimpleConfig rts_config) +{ + RtsConfig conf = defaultRtsConfig; + conf.rts_opts_enabled = rts_config.rts_opts_enabled; + conf.rts_opts_suggestions = rts_config.rts_opts_suggestions; + conf.keep_cafs = rts_config.keep_cafs; + conf.rts_opts = rts_config.rts_opts; + conf.rts_hs_main = true; + hs_main(argc, argv, main_closure, conf); +} + # endif /* BATCH_MODE */ diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in index 674566c0ad..1c27255fde 100644 --- a/rts/rts.cabal.in +++ b/rts/rts.cabal.in @@ -138,6 +138,7 @@ library rts/LibdwPool.h rts/Linker.h rts/Main.h + rts/SimpleMain.h rts/Messages.h rts/OSThreads.h rts/Parallel.h |