[project @ 2000-01-13 12:40:15 by simonmar]

- remove AllBlocked scheduler return code.  Nobody owned up to having
  created it or even knowing what it was there for.

- clean up fatal error condition handling somewhat.  The process
  exit code from a GHC program now indicates the kind of failure
  for certain kinds of exit:

	general internal RTS error	254
	program deadlocked		253
	program interrupted (ctrl-C)	252
	heap overflow			251
	main thread killed		250

  and we leave exit codes 1-199 for the user (as is traditional at MS,
  200-249 are reserved for future expansion, and may contain
  undocumented extensions :-)

diff --git a/ghc/includes/Rts.h b/ghc/includes/Rts.h
index 355ca9f..7d35118 100644 (file)
--- a/ghc/includes/Rts.h
+++ b/ghc/includes/Rts.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Rts.h,v 1.10 2000/01/12 15:15:17 simonmar Exp $
+ * $Id: Rts.h,v 1.11 2000/01/13 12:40:15 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -16,7 +16,7 @@
 #include "Stg.h"
 
 /* -----------------------------------------------------------------------------
-   Miscellaneous garbage
+   RTS Exit codes
    -------------------------------------------------------------------------- */
 
 #if ! defined(EXIT_SUCCESS) || ! defined(EXIT_FAILURE)
@@ -27,6 +27,17 @@
 #define EXIT_FAILURE 1
 #endif
 
+/* 255 is allegedly used by dynamic linkers to report linking failure */
+#define EXIT_INTERNAL_ERROR 254
+#define EXIT_DEADLOCK       253
+#define EXIT_INTERRUPTED    252
+#define EXIT_HEAPOVERFLOW   251
+#define EXIT_KILLED         250
+
+/* -----------------------------------------------------------------------------
+   Miscellaneous garbage
+   -------------------------------------------------------------------------- */
+
 /* declarations for runtime flags/values */
 #define MAX_RTS_ARGS 32
 

diff --git a/ghc/includes/RtsAPI.h b/ghc/includes/RtsAPI.h
index aeccc7c..b6d5df7 100644 (file)
--- a/ghc/includes/RtsAPI.h
+++ b/ghc/includes/RtsAPI.h
@@ -1,5 +1,5 @@
 /* ----------------------------------------------------------------------------
- * $Id: RtsAPI.h,v 1.8 1999/11/02 15:05:52 simonmar Exp $
+ * $Id: RtsAPI.h,v 1.9 2000/01/13 12:40:15 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -18,10 +18,9 @@ typedef enum {
     Success,      
     Killed,     /* another thread killed us                           */
     Interrupted, /* stopped in response to a call to interruptStgRts   */
-    Deadlock,   
-    AllBlocked,  /* subtly different from Deadlock                     */
+    Deadlock    /* no threads to run, but main thread hasn't finished */
 } SchedulerStatus;
-      
+
 typedef StgClosure *HaskellObj;
 
 /* ----------------------------------------------------------------------------

diff --git a/ghc/rts/Itimer.c b/ghc/rts/Itimer.c
index dc17e49..0db283c 100644 (file)
--- a/ghc/rts/Itimer.c
+++ b/ghc/rts/Itimer.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Itimer.c,v 1.7 1999/12/01 14:19:36 simonmar Exp $
+ * $Id: Itimer.c,v 1.8 2000/01/13 12:40:15 simonmar Exp $
  *
  * (c) The GHC Team, 1995-1999
  *
@@ -160,8 +160,7 @@ initialize_virtual_timer(nat ms)
     se.sigev_signo = SIGVTALRM;
     se.sigev_value.sival_int = SIGVTALRM;
     if (timer_create(CLOCK_VIRTUAL, &se, &tid)) {
-       fprintf(stderr, "Can't create virtual timer.\n");
-       EXIT(EXIT_FAILURE);
+       barf("can't create virtual timer");
     }
     it.it_value.tv_sec = ms / 1000;
     it.it_value.tv_nsec = 1000000 * (ms - 1000 * it.it_value.tv_sec);

diff --git a/ghc/rts/Main.c b/ghc/rts/Main.c
index a15a037..09e6e21 100644 (file)
--- a/ghc/rts/Main.c
+++ b/ghc/rts/Main.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Main.c,v 1.12 1999/11/02 15:05:58 simonmar Exp $
+ * $Id: Main.c,v 1.13 2000/01/13 12:40:15 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -40,6 +40,8 @@
 # ifndef INTERPRETER /* Hack */
 int main(int argc, char *argv[])
 {
+    int exit_status;
+
     SchedulerStatus status;
     startupHaskell(argc,argv);
 
@@ -58,17 +60,24 @@ int main(int argc, char *argv[])
     }
 #  endif /* PAR */
     switch (status) {
-    case AllBlocked:
-      barf("Scheduler stopped, all threads blocked");
     case Deadlock:
-      shutdownHaskell();
-      barf("No threads to run!  Deadlock?");
+      prog_belch("no threads to run:  infinite loop or deadlock?");
+      exit_status = EXIT_DEADLOCK;
+      break;
     case Killed:
-      belch("%s: warning: main thread killed", prog_argv[0]);
-    case Success:
+      prog_belch("main thread killed");
+      exit_status = EXIT_KILLED;
+      break;
     case Interrupted:
-      /* carry on */
+      prog_belch("interrupted");
+      exit_status = EXIT_INTERRUPTED;
+      break;
+    case Success:
+      exit_status = EXIT_SUCCESS;
+      break;
+    case NoStatus:
+      barf("main thread completed with no status");
     }
-    shutdownHaskellAndExit(EXIT_SUCCESS);
+    shutdownHaskellAndExit(exit_status);
 }
 # endif /* BATCH_MODE */

diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc
index b88dd72..01d0a0a 100644 (file)
--- a/ghc/rts/PrimOps.hc
+++ b/ghc/rts/PrimOps.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.37 2000/01/06 11:57:50 sewardj Exp $
+ * $Id: PrimOps.hc,v 1.38 2000/01/13 12:40:15 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -897,8 +897,7 @@ FN_(putMVarzh_fast)
 #endif
 
   if (info == &FULL_MVAR_info) {
-    fprintf(stderr, "putMVar#: MVar already full.\n");
-    stg_exit(EXIT_FAILURE);
+    barf("putMVar#: MVar already full");
   }
   
   mvar->value = R2.cl;

diff --git a/ghc/rts/RtsFlags.c b/ghc/rts/RtsFlags.c
index 57565b7..c3c0515 100644 (file)
--- a/ghc/rts/RtsFlags.c
+++ b/ghc/rts/RtsFlags.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsFlags.c,v 1.22 2000/01/12 15:15:17 simonmar Exp $
+ * $Id: RtsFlags.c,v 1.23 2000/01/13 12:40:15 simonmar Exp $
  *
  * (c) The AQUA Project, Glasgow University, 1994-1997
  * (c) The GHC Team, 1998-1999
@@ -931,7 +931,6 @@ decode(const char *s)
 static void
 bad_option(const char *s)
 {
-  fflush(stdout);
-  fprintf(stderr, "initSM: Bad RTS option: %s\n", s);
+  prog_belch("bad RTS option: %s", s);
   stg_exit(EXIT_FAILURE);
-}              
+}

diff --git a/ghc/rts/RtsUtils.c b/ghc/rts/RtsUtils.c
index 24ef889..28fb2f7 100644 (file)
--- a/ghc/rts/RtsUtils.c
+++ b/ghc/rts/RtsUtils.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsUtils.c,v 1.11 2000/01/12 15:15:17 simonmar Exp $
+ * $Id: RtsUtils.c,v 1.12 2000/01/13 12:40:16 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -40,7 +40,7 @@ void barf(char *s, ...)
   vfprintf(stderr, s, ap);
   fprintf(stderr, "\n");
   fflush(stderr);
-  stg_exit(EXIT_FAILURE);
+  stg_exit(EXIT_INTERNAL_ERROR);
 }
 
 void prog_belch(char *s, ...)
@@ -73,8 +73,8 @@ stgMallocBytes (int n, char *msg)
 
     if ((space = (char *) malloc((size_t) n)) == NULL) {
       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-       MallocFailHook((W_) n, msg); /*msg*/
-       stg_exit(EXIT_FAILURE);
+      MallocFailHook((W_) n, msg); /*msg*/
+      stg_exit(EXIT_INTERNAL_ERROR);
     }
     return space;
 }
@@ -86,8 +86,8 @@ stgReallocBytes (void *p, int n, char *msg)
 
     if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-       MallocFailHook((W_) n, msg); /*msg*/
-       exit(EXIT_FAILURE);
+      MallocFailHook((W_) n, msg); /*msg*/
+      stg_exit(EXIT_INTERNAL_ERROR);
     }
     return space;
 }
@@ -139,7 +139,7 @@ heapOverflow(void)
   if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 #endif
 
-  stg_exit(EXIT_FAILURE);
+  stg_exit(EXIT_HEAPOVERFLOW);
 }
 
 /* -----------------------------------------------------------------------------

diff --git a/ghc/rts/Select.c b/ghc/rts/Select.c
index 0fcde60..87f3267 100644 (file)
--- a/ghc/rts/Select.c
+++ b/ghc/rts/Select.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Select.c,v 1.6 2000/01/12 15:15:18 simonmar Exp $
+ * $Id: Select.c,v 1.7 2000/01/13 12:40:16 simonmar Exp $
  *
  * (c) The GHC Team 1995-1999
  *
@@ -136,8 +136,7 @@ awaitEvent(rtsBool wait)
       if (errno != EINTR) {
        /* fflush(stdout); */
        perror("select");
-       fprintf(stderr, "awaitEvent: select failed\n");
-       stg_exit(EXIT_FAILURE);
+       barf("select failed");
       }
       ACQUIRE_LOCK(&sched_mutex);
 

diff --git a/ghc/rts/Signals.c b/ghc/rts/Signals.c
index f044325..9c6e058 100644 (file)
--- a/ghc/rts/Signals.c
+++ b/ghc/rts/Signals.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Signals.c,v 1.11 2000/01/12 15:15:18 simonmar Exp $
+ * $Id: Signals.c,v 1.12 2000/01/13 12:40:16 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -48,8 +48,7 @@ more_handlers(I_ sig)
 
     if (handlers == NULL) {
       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-      fprintf(stderr, "VM exhausted (in more_handlers)\n");
-      exit(EXIT_FAILURE);
+      barf("VM exhausted (in more_handlers)");
     }
     for(i = nHandlers; i <= sig; i++)
       /* Fill in the new slots with default actions */
@@ -230,9 +229,7 @@ StgInt
 sig_install(StgInt sig, StgInt spi, StgStablePtr handler, sigset_t *mask)
 {
   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-  fprintf(stderr,
-         "No signal handling support in a parallel implementation.\n");
-  exit(EXIT_FAILURE);
+  barf("no signal handling support in a parallel implementation");
 }
 
 void
@@ -266,7 +263,7 @@ shutdown_handler(int sig STG_UNUSED)
   } else
 #endif
 
-  shutdownHaskellAndExit(EXIT_FAILURE);
+  shutdownHaskellAndExit(EXIT_INTERRUPTED);
 }
 
 /*