summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ghc/includes/Rts.h15
-rw-r--r--ghc/includes/RtsAPI.h7
-rw-r--r--ghc/rts/Itimer.c5
-rw-r--r--ghc/rts/Main.c27
-rw-r--r--ghc/rts/PrimOps.hc5
-rw-r--r--ghc/rts/RtsFlags.c7
-rw-r--r--ghc/rts/RtsUtils.c14
-rw-r--r--ghc/rts/Select.c5
-rw-r--r--ghc/rts/Signals.c11
9 files changed, 54 insertions, 42 deletions
diff --git a/ghc/includes/Rts.h b/ghc/includes/Rts.h
index 355ca9f1a1..7d3511837a 100644
--- 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 aeccc7c3fd..b6d5df7c58 100644
--- 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 dc17e49f88..0db283c662 100644
--- 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 a15a0375b1..09e6e218a9 100644
--- 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 b88dd72bb2..01d0a0aa40 100644
--- 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 57565b74ef..c3c05153d2 100644
--- 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 24ef889808..28fb2f73da 100644
--- 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 0fcde6039e..87f3267c82 100644
--- 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 f0443253ed..9c6e058fa4 100644
--- 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);
}
/*
View Lorry Controller Status