diff options
| -rw-r--r-- | compiler/Makefile | 12 | ||||
| -rw-r--r-- | includes/RtsAPI.h | 2 | ||||
| -rw-r--r-- | rts/Linker.c | 1 | ||||
| -rw-r--r-- | rts/RtsFlags.c | 28 | ||||
| -rw-r--r-- | rts/RtsStartup.c | 1 |
5 files changed, 42 insertions, 2 deletions
diff --git a/compiler/Makefile b/compiler/Makefile index dcaf18ed85..0b84536030 100644 --- a/compiler/Makefile +++ b/compiler/Makefile @@ -710,9 +710,17 @@ EXCLUDED_SRCS += $(INPLACE_HS) # will go wrong when we use it in a Haskell string below. TOP_ABS=$(subst \\,/,$(FPTOOLS_TOP_ABS_PLATFORM)) +ifeq "$(stage)" "1" +EnvImport = System.Environment +GetArgs = getArgs +else +EnvImport = GHC.Environment +GetArgs = getFullArgs +endif + $(INPLACE_HS): Makefile $(FPTOOLS_TOP)/mk/config.mk - echo "import System.Cmd; import System.Environment; import System.Exit" > $@ - echo "main = do args <- getArgs; rawSystem \"$(TOP_ABS)/$(GHC_COMPILER_DIR_REL)/$(GHC_PROG)\" (\"-B$(TOP_ABS)\":args) >>= exitWith" >> $@ + echo "import System.Cmd; import $(EnvImport); import System.Exit" > $@ + echo "main = do args <- $(GetArgs); rawSystem \"$(TOP_ABS)/$(GHC_COMPILER_DIR_REL)/$(GHC_PROG)\" (\"-B$(TOP_ABS)\":args) >>= exitWith" >> $@ $(INPLACE_PROG): $(INPLACE_HS) $(HC) --make $< -o $@ diff --git a/includes/RtsAPI.h b/includes/RtsAPI.h index 7d28328080..54fa3ee560 100644 --- a/includes/RtsAPI.h +++ b/includes/RtsAPI.h @@ -42,6 +42,8 @@ extern void shutdownHaskell ( void ); extern void shutdownHaskellAndExit ( int exitCode ); extern void getProgArgv ( int *argc, char **argv[] ); extern void setProgArgv ( int argc, char *argv[] ); +extern void getFullProgArgv ( int *argc, char **argv[] ); +extern void setFullProgArgv ( int argc, char *argv[] ); /* exit() override */ extern void (*exitFn)(int); diff --git a/rts/Linker.c b/rts/Linker.c index d8d61a07af..243eae1b76 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -523,6 +523,7 @@ typedef struct _RtsSymbolVal { SymX(genSymZh) \ SymX(genericRaise) \ SymX(getProgArgv) \ + SymX(getFullProgArgv) \ SymX(getStablePtr) \ SymX(hs_init) \ SymX(hs_exit) \ diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index 9dd6b19312..a2d699daf7 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -28,6 +28,8 @@ RTS_FLAGS RtsFlags; */ int prog_argc = 0; /* an "int" so as to match normal "argc" */ char **prog_argv = NULL; +int full_prog_argc = 0; /* an "int" so as to match normal "argc" */ +char **full_prog_argv = NULL; char *prog_name = NULL; /* 'basename' of prog_argv[0] */ int rts_argc = 0; /* ditto */ char *rts_argv[MAX_RTS_ARGS]; @@ -2411,3 +2413,29 @@ setProgArgv(int argc, char *argv[]) prog_argv = argv; setProgName(prog_argv); } + +/* These functions record and recall the full arguments, including the + +RTS ... -RTS options. The reason for adding them was so that the + ghc-inplace program can pass /all/ the arguments on to the real ghc. */ +void +getFullProgArgv(int *argc, char **argv[]) +{ + if (argc) { *argc = full_prog_argc; } + if (argv) { *argv = full_prog_argv; } +} + +void +setFullProgArgv(int argc, char *argv[]) +{ + int i; + full_prog_argc = argc; + full_prog_argv = stgCallocBytes(argc + 1, sizeof (char *), + "setFullProgArgv 1"); + for (i = 0; i < argc; i++) { + full_prog_argv[i] = stgMallocBytes(strlen(argv[i]) + 1, + "setFullProgArgv 2"); + strcpy(full_prog_argv[i], argv[i]); + } + full_prog_argv[argc] = NULL; +} + diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index 7dce06e640..a363c133f4 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -199,6 +199,7 @@ hs_init(int *argc, char **argv[]) /* Parse the flags, separating the RTS flags from the programs args */ if (argc != NULL && argv != NULL) { + setFullProgArgv(*argc,*argv); setupRtsFlags(argc, *argv, &rts_argc, rts_argv); setProgArgv(*argc,*argv); } |