From be587a37ca135acccdb273370852dcb4202be5cd Mon Sep 17 00:00:00 2001 From: simonmar Date: Thu, 13 Jan 2000 12:40:16 +0000 Subject: [PATCH] [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 :-) --- ghc/includes/Rts.h | 15 +++++++++++++-- ghc/includes/RtsAPI.h | 7 +++---- ghc/rts/Itimer.c | 5 ++--- ghc/rts/Main.c | 27 ++++++++++++++++++--------- ghc/rts/PrimOps.hc | 5 ++--- ghc/rts/RtsFlags.c | 7 +++---- ghc/rts/RtsUtils.c | 14 +++++++------- ghc/rts/Select.c | 5 ++--- ghc/rts/Signals.c | 11 ++++------- 9 files changed, 54 insertions(+), 42 deletions(-) diff --git a/ghc/includes/Rts.h b/ghc/includes/Rts.h index 355ca9f..7d35118 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 aeccc7c..b6d5df7 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 dc17e49..0db283c 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 a15a037..09e6e21 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 b88dd72..01d0a0a 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 57565b7..c3c0515 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 24ef889..28fb2f7 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 0fcde60..87f3267 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 f044325..9c6e058 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); } /* -- 1.7.10.4