Commit 8bac4788 authored by Ian Lynagh's avatar Ian Lynagh

Implement the RTS side of GHC.Environment.getFullArgs

parent 1d708730
......@@ -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 $@
......
......@@ -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);
......
......@@ -523,6 +523,7 @@ typedef struct _RtsSymbolVal {
SymX(genSymZh) \
SymX(genericRaise) \
SymX(getProgArgv) \
SymX(getFullProgArgv) \
SymX(getStablePtr) \
SymX(hs_init) \
SymX(hs_exit) \
......
......@@ -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;
}
......@@ -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);
}
......
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