[project @ 2003-08-22 22:24:12 by sof]

setupRtsFlags(): don't overwrite argv[0] with its basename:
   - argv[] may not point to writeable memory
   - System.Environment.getProgName strips off the 'dirname' portion
     anyway.
   - Not possible to get at the untransformed argv[0] from
     Haskell code, should such a need arise.

Uses of prog_argv[0] within the RTS has now been replaced with prog_name,
which is the basename of prog_argv[0].

diff --git a/ghc/includes/Stg.h b/ghc/includes/Stg.h
index b6bbcfa..05ae7d1 100644 (file)
--- a/ghc/includes/Stg.h
+++ b/ghc/includes/Stg.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Stg.h,v 1.54 2003/07/22 13:23:44 simonmar Exp $
+ * $Id: Stg.h,v 1.55 2003/08/22 22:24:16 sof Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -229,6 +229,7 @@ typedef StgWord64       LW_;
 /* Misc stuff without a home */
 DLL_IMPORT_RTS extern char **prog_argv;        /* so we can get at these from Haskell */
 DLL_IMPORT_RTS extern int    prog_argc;
+DLL_IMPORT_RTS extern char  *prog_name;
 
 extern void stackOverflow(void);
 

diff --git a/ghc/rts/ProfHeap.c b/ghc/rts/ProfHeap.c
index e0979a4..19beb9c 100644 (file)
--- a/ghc/rts/ProfHeap.c
+++ b/ghc/rts/ProfHeap.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: ProfHeap.c,v 1.46 2003/05/16 14:16:53 simonmar Exp $
+ * $Id: ProfHeap.c,v 1.47 2003/08/22 22:24:12 sof Exp $
  *
  * (c) The GHC Team, 1998-2003
  *
@@ -407,7 +407,7 @@ initHeapProfiling(void)
 
     initEra( &censuses[era] );
 
-    fprintf(hp_file, "JOB \"%s", prog_argv[0]);
+    fprintf(hp_file, "JOB \"%s", prog_name);
 
 #ifdef PROFILING
     {
@@ -432,7 +432,7 @@ initHeapProfiling(void)
     fprintf(hp_file, "END_SAMPLE 0.00\n");
 
 #ifdef DEBUG_HEAP_PROF
-    DEBUG_LoadSymbols(prog_argv[0]);
+    DEBUG_LoadSymbols(prog_name);
 #endif
 
 #ifdef PROFILING

diff --git a/ghc/rts/Profiling.c b/ghc/rts/Profiling.c
index c5baff0..a7466c7 100644 (file)
--- a/ghc/rts/Profiling.c
+++ b/ghc/rts/Profiling.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Profiling.c,v 1.36 2003/02/22 04:51:52 sof Exp $
+ * $Id: Profiling.c,v 1.37 2003/08/22 22:24:13 sof Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -261,8 +261,8 @@ static void
 initProfilingLogFile(void)
 {
     /* Initialise the log file name */
-    prof_filename = arenaAlloc(prof_arena, strlen(prog_argv[0]) + 6);
-    sprintf(prof_filename, "%s.prof", prog_argv[0]);
+    prof_filename = arenaAlloc(prof_arena, strlen(prog_name) + 6);
+    sprintf(prof_filename, "%s.prof", prog_name);
 
     /* open the log file */
     if ((prof_file = fopen(prof_filename, "w")) == NULL) {
@@ -292,8 +292,8 @@ initProfilingLogFile(void)
     
     if (RtsFlags.ProfFlags.doHeapProfile) {
        /* Initialise the log file name */
-       hp_filename = arenaAlloc(prof_arena, strlen(prog_argv[0]) + 6);
-       sprintf(hp_filename, "%s.hp", prog_argv[0]);
+       hp_filename = arenaAlloc(prof_arena, strlen(prog_name) + 6);
+       sprintf(hp_filename, "%s.hp", prog_name);
        
        /* open the log file */
        if ((hp_file = fopen(hp_filename, "w")) == NULL) {
@@ -722,7 +722,7 @@ reportCCSProfiling( void )
            time_str(), "Final");
 
     fprintf(prof_file, "\n\t  ");
-    fprintf(prof_file, " %s", prog_argv[0]);
+    fprintf(prof_file, " %s", prog_name);
     fprintf(prof_file, " +RTS");
     for (count = 0; rts_argv[count]; count++)
        fprintf(prof_file, " %s", rts_argv[count]);

diff --git a/ghc/rts/RtsFlags.c b/ghc/rts/RtsFlags.c
index 55effe2..99bdb1a 100644 (file)
--- a/ghc/rts/RtsFlags.c
+++ b/ghc/rts/RtsFlags.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsFlags.c,v 1.68 2003/04/21 14:45:28 sof Exp $
+ * $Id: RtsFlags.c,v 1.69 2003/08/22 22:24:13 sof Exp $
  *
  * (c) The AQUA Project, Glasgow University, 1994-1997
  * (c) The GHC Team, 1998-1999
@@ -41,8 +41,9 @@ extern struct RTS_FLAGS RtsFlags;
 /*
  * Split argument lists
  */
-int     prog_argc = 0; /* an "int" so as to match normal "argc" */
+int     prog_argc = 0;    /* an "int" so as to match normal "argc" */
 char  **prog_argv = NULL;
+char   *prog_name = NULL; /* 'basename' of prog_argv[0] */
 int     rts_argc = 0;  /* ditto */
 char   *rts_argv[MAX_RTS_ARGS];
 
@@ -497,9 +498,11 @@ setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[])
     char *last_slash;
 
     /* Remove directory from argv[0] -- default files in current directory */
-
-    if ((last_slash = (char *) strrchr(argv[0], '/')) != NULL)
-       strcpy(argv[0], last_slash+1);
+    if ((last_slash = (char *) strrchr(argv[0], '/')) != NULL) {
+       prog_name = last_slash+1;
+    } else {
+       prog_name = argv[0];
+    }
 
     total_arg = *argc;
     arg = 1;

diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c
index 099f891..0c5c2a3 100644 (file)
--- a/ghc/rts/RtsStartup.c
+++ b/ghc/rts/RtsStartup.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.74 2003/08/19 16:32:23 simonmar Exp $
+ * $Id: RtsStartup.c,v 1.75 2003/08/22 22:24:15 sof Exp $
  *
  * (c) The GHC Team, 1998-2002
  *
@@ -197,8 +197,8 @@ startupHaskell(int argc, char *argv[], void (*init_root)(void))
 void
 getProgArgv(int *argc, char **argv[])
 {
-    *argc = prog_argc;
-    *argv = prog_argv;
+    if (argc) { *argc = prog_argc; }
+    if (argv) { *argv = prog_argv; }
 }
 
 void

diff --git a/ghc/rts/RtsUtils.c b/ghc/rts/RtsUtils.c
index 8f6579c..9637db0 100644 (file)
--- a/ghc/rts/RtsUtils.c
+++ b/ghc/rts/RtsUtils.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsUtils.c,v 1.34 2003/04/01 15:40:27 sof Exp $
+ * $Id: RtsUtils.c,v 1.35 2003/08/22 22:24:16 sof Exp $
  *
  * (c) The GHC Team, 1998-2002
  *
@@ -42,8 +42,8 @@ barf(char *s, ...)
   va_list ap;
   va_start(ap,s);
   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-  if (prog_argv != NULL && prog_argv[0] != NULL) {
-    fprintf(stderr, "%s: internal error: ", prog_argv[0]);
+  if (prog_argv != NULL && prog_name != NULL) {
+    fprintf(stderr, "%s: internal error: ", prog_name);
   } else {
     fprintf(stderr, "internal error: ");
   }
@@ -61,8 +61,8 @@ prog_belch(char *s, ...)
   va_list ap;
   va_start(ap,s);
   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-  if (prog_argv != NULL && prog_argv[0] != NULL) {
-    fprintf(stderr, "%s: ", prog_argv[0]);
+  if (prog_argv != NULL && prog_name != NULL) {
+    fprintf(stderr, "%s: ", prog_name);
   } 
   vfprintf(stderr, s, ap);
   fprintf(stderr, "\n");