From: simonmar <unknown>
Date: Thu, 3 Feb 2005 10:57:08 +0000 (+0000)
Subject: [project @ 2005-02-03 10:57:06 by simonmar]
X-Git-Tag: Initial_conversion_from_CVS_complete~1118
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=4e48260554b72e73932a8d5b7c097a047814ab83

[project @ 2005-02-03 10:57:06 by simonmar]
Make setProgArgv() set the RTS's idea of the prog name too.
---

diff --git a/ghc/rts/HsFFI.c b/ghc/rts/HsFFI.c
index b89726c..350bcfb 100644
--- a/ghc/rts/HsFFI.c
+++ b/ghc/rts/HsFFI.c
@@ -1,6 +1,6 @@
 /* -----------------------------------------------------------------------------
  *
- * (c) The GHC Team, 2002
+ * (c) The GHC Team, 2005
  *
  * RTS entry points as mandated by the FFI addendum to the Haskell 98 report
  *
@@ -14,8 +14,7 @@
 void
 hs_set_argv(int argc, char *argv[])
 {
-    prog_argc = argc;
-    prog_argv = argv;
+    setProgArgv(argc,argv);
 }
 
 void
diff --git a/ghc/rts/RtsFlags.c b/ghc/rts/RtsFlags.c
index 85c31db..37c22d1 100644
--- a/ghc/rts/RtsFlags.c
+++ b/ghc/rts/RtsFlags.c
@@ -499,21 +499,8 @@ setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[])
     rtsBool error = rtsFalse;
     I_ mode;
     I_ arg, total_arg;
-    char *last_slash;
-
-    /* Remove directory from argv[0] -- default files in current directory */
-    if ((last_slash = (char *) strrchr(argv[0], 
-#if !defined(mingw32_HOST_OS)
-				       '/')
-#else
-				       '\\')
-#endif
-				       ) != NULL) {
-	prog_name = last_slash+1;
-    } else {
-	prog_name = argv[0];
-    }
 
+    setProgName (argv);
     total_arg = *argc;
     arg = 1;
 
@@ -2191,3 +2178,48 @@ bad_option(const char *s)
   errorBelch("bad RTS option: %s", s);
   stg_exit(EXIT_FAILURE);
 }
+
+/* -----------------------------------------------------------------------------
+   Getting/Setting the program's arguments.
+
+   These are used by System.Environment, and parts of the RTS.
+   -------------------------------------------------------------------------- */
+
+void
+setProgName(char *argv[])
+{
+    char *last_slash;
+
+    /* Remove directory from argv[0] -- default files in current directory */
+    if ((last_slash = (char *) strrchr(argv[0], 
+#if !defined(mingw32_HOST_OS)
+				       '/'
+#else
+				       '\\'
+#endif
+				       )) != NULL) {
+	prog_name = last_slash+1;
+   } else {
+	prog_name = argv[0];
+   }
+}
+
+void
+getProgArgv(int *argc, char **argv[])
+{
+    if (argc) { *argc = prog_argc; }
+    if (argv) { *argv = prog_argv; }
+}
+
+void
+setProgArgv(int argc, char *argv[])
+{
+   /* Usually this is done by startupHaskell, so we don't need to call this. 
+      However, sometimes Hugs wants to change the arguments which Haskell
+      getArgs >>= ... will be fed.  So you can do that by calling here
+      _after_ calling startupHaskell.
+   */
+   prog_argc = argc;
+   prog_argv = argv;
+   setProgName(prog_argv);
+}
diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c
index c5fa744..af39aa6 100644
--- a/ghc/rts/RtsStartup.c
+++ b/ghc/rts/RtsStartup.c
@@ -159,8 +159,7 @@ hs_init(int *argc, char **argv[])
     /* Parse the flags, separating the RTS flags from the programs args */
     if (argc != NULL && argv != NULL) {
 	setupRtsFlags(argc, *argv, &rts_argc, rts_argv);
-	prog_argc = *argc;
-	prog_argv = *argv;
+	setProgArgv(*argc,*argv);
     }
 
 #if defined(PAR)
@@ -250,31 +249,6 @@ startupHaskell(int argc, char *argv[], void (*init_root)(void))
 
 
 /* -----------------------------------------------------------------------------
-   Getting/Setting the program's arguments.
-
-   These are used by System.Environment.
-   -------------------------------------------------------------------------- */
-
-void
-getProgArgv(int *argc, char **argv[])
-{
-    if (argc) { *argc = prog_argc; }
-    if (argv) { *argv = prog_argv; }
-}
-
-void
-setProgArgv(int argc, char *argv[])
-{
-   /* Usually this is done by startupHaskell, so we don't need to call this. 
-      However, sometimes Hugs wants to change the arguments which Haskell
-      getArgs >>= ... will be fed.  So you can do that by calling here
-      _after_ calling startupHaskell.
-   */
-   prog_argc = argc;
-   prog_argv = argv;
-}
-
-/* -----------------------------------------------------------------------------
    Per-module initialisation
 
    This process traverses all the compiled modules in the program