Commit 3ddfdc19 authored by simonmar's avatar simonmar

[project @ 2000-03-16 17:27:12 by simonmar]

Raise an exception in any thread that is about to be garbage
collected.

	- threads blocked on MVars that are otherwise garbage
	  will receive a BlockedOnDeadMVar exception.

	- threads blocked on Black Holes must be in some kind
	  of deadlock, so we send them a NonTermination exception.
parent cdcd92dc
% -----------------------------------------------------------------------------
% $Id: PrelException.lhs,v 1.12 2000/03/13 10:54:49 simonmar Exp $
% $Id: PrelException.lhs,v 1.13 2000/03/16 17:27:13 simonmar Exp $
%
% (c) The GRAP/AQUA Project, Glasgow University, 1998
%
......@@ -38,7 +38,8 @@ data Exception
| AssertionFailed String -- Assertions
| DynException Dynamic -- Dynamic exceptions
| AsyncException AsyncException -- Externally generated errors
| PutFullMVar -- Put on a full MVar
| PutFullMVar -- Put on a full MVar
| BlockedOnDeadMVar -- Blocking on a dead MVar
| NonTermination
data ArithException
......@@ -85,6 +86,7 @@ instance Show Exception where
showsPrec _ (AsyncException e) = shows e
showsPrec _ (DynException _err) = showString "unknown exception"
showsPrec _ (PutFullMVar) = showString "putMVar: full MVar"
showsPrec _ (BlockedOnDeadMVar) = showString "thread blocked indefinitely"
showsPrec _ (NonTermination) = showString "<<loop>>"
-- Primitives:
......
/* -----------------------------------------------------------------------------
* $Id: GC.c,v 1.72 2000/01/22 18:00:03 simonmar Exp $
* $Id: GC.c,v 1.73 2000/03/16 17:27:12 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
......@@ -42,6 +42,7 @@
#include "SchedAPI.h"
#include "Weak.h"
#include "StablePriv.h"
#include "Prelude.h"
#if defined(GRAN) || defined(PAR)
# include "GranSimRts.h"
# include "ParallelRts.h"
......@@ -108,11 +109,16 @@ static rtsBool major_gc;
*/
static nat evac_gen;
/* WEAK POINTERS
/* Weak pointers
*/
static StgWeak *old_weak_ptr_list; /* also pending finaliser list */
static rtsBool weak_done; /* all done for this pass */
/* List of all threads during GC
*/
static StgTSO *old_all_threads;
static StgTSO *resurrected_threads;
/* Flag indicating failure to evacuate an object to the desired
* generation.
*/
......@@ -122,6 +128,7 @@ static rtsBool failed_to_evac;
*/
bdescr *old_to_space;
/* Data used for allocation area sizing.
*/
lnat new_blocks; /* blocks allocated during this GC */
......@@ -386,6 +393,13 @@ void GarbageCollect(void (*get_roots)(void))
weak_ptr_list = NULL;
weak_done = rtsFalse;
/* The all_threads list is like the weak_ptr_list.
* See traverse_weak_ptr_list() for the details.
*/
old_all_threads = all_threads;
all_threads = END_TSO_QUEUE;
resurrected_threads = END_TSO_QUEUE;
/* Mark the stable pointer table.
*/
markStablePtrTable(major_gc);
......@@ -718,6 +732,9 @@ void GarbageCollect(void (*get_roots)(void))
/* start any pending finalizers */
scheduleFinalizers(old_weak_ptr_list);
/* send exceptions to any threads which were about to die */
resurrectThreads(resurrected_threads);
/* check sanity after GC */
IF_DEBUG(sanity, checkSanity(N));
......@@ -825,7 +842,45 @@ traverse_weak_ptr_list(void)
continue;
}
}
/* Now deal with the all_threads list, which behaves somewhat like
* the weak ptr list. If we discover any threads that are about to
* become garbage, we wake them up and administer an exception.
*/
{
StgTSO *t, *tmp, *next, **prev;
prev = &old_all_threads;
for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
/* Threads which have finished or died get dropped from
* the list.
*/
switch (t->whatNext) {
case ThreadKilled:
case ThreadComplete:
next = t->global_link;
*prev = next;
continue;
default:
}
/* Threads which have already been determined to be alive are
* moved onto the all_threads list.
*/
(StgClosure *)tmp = isAlive((StgClosure *)t);
if (tmp != NULL) {
next = tmp->global_link;
tmp->global_link = all_threads;
all_threads = tmp;
*prev = next;
} else {
prev = &(t->global_link);
next = t->global_link;
}
}
}
/* If we didn't make any changes, then we can go round and kill all
* the dead weak pointers. The old_weak_ptr list is used as a list
* of pending finalizers later on.
......@@ -835,6 +890,19 @@ traverse_weak_ptr_list(void)
for (w = old_weak_ptr_list; w; w = w->link) {
w->finalizer = evacuate(w->finalizer);
}
/* And resurrect any threads which were about to become garbage.
*/
{
StgTSO *t, *tmp, *next;
for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
next = t->global_link;
(StgClosure *)tmp = evacuate((StgClosure *)t);
tmp->global_link = resurrected_threads;
resurrected_threads = tmp;
}
}
weak_done = rtsTrue;
}
......@@ -888,6 +956,7 @@ StgClosure *
isAlive(StgClosure *p)
{
const StgInfoTable *info;
nat size;
while (1) {
......@@ -922,6 +991,33 @@ isAlive(StgClosure *p)
/* alive! */
return ((StgEvacuated *)p)->evacuee;
case BCO:
size = bco_sizeW((StgBCO*)p);
goto large;
case ARR_WORDS:
size = arr_words_sizeW((StgArrWords *)p);
goto large;
case MUT_ARR_PTRS:
case MUT_ARR_PTRS_FROZEN:
size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
goto large;
case TSO:
if (((StgTSO *)p)->whatNext == ThreadRelocated) {
p = (StgClosure *)((StgTSO *)p)->link;
continue;
}
size = tso_sizeW((StgTSO *)p);
large:
if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)
&& Bdescr((P_)p)->evacuated)
return p;
else
return NULL;
default:
/* dead. */
return NULL;
......@@ -1339,15 +1435,15 @@ loop:
case IND_PERM:
case IND_OLDGEN:
case IND_OLDGEN_PERM:
selectee = stgCast(StgInd *,selectee)->indirectee;
selectee = ((StgInd *)selectee)->indirectee;
goto selector_loop;
case CAF_ENTERED:
selectee = stgCast(StgCAF *,selectee)->value;
selectee = ((StgCAF *)selectee)->value;
goto selector_loop;
case EVACUATED:
selectee = stgCast(StgEvacuated*,selectee)->evacuee;
selectee = ((StgEvacuated *)selectee)->evacuee;
goto selector_loop;
case THUNK:
......@@ -1436,7 +1532,7 @@ loop:
case PAP:
/* these are special - the payload is a copy of a chunk of stack,
tagging and all. */
return copy(q,pap_sizeW(stgCast(StgPAP*,q)),step);
return copy(q,pap_sizeW((StgPAP *)q),step);
case EVACUATED:
/* Already evacuated, just return the forwarding address.
......@@ -1458,7 +1554,7 @@ loop:
case ARR_WORDS:
{
nat size = arr_words_sizeW(stgCast(StgArrWords*,q));
nat size = arr_words_sizeW((StgArrWords *)q);
if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
evacuate_large((P_)q, rtsFalse);
......@@ -1472,7 +1568,7 @@ loop:
case MUT_ARR_PTRS:
case MUT_ARR_PTRS_FROZEN:
{
nat size = mut_arr_ptrs_sizeW(stgCast(StgMutArrPtrs*,q));
nat size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)q);
if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
evacuate_large((P_)q, info->type == MUT_ARR_PTRS);
......@@ -1639,7 +1735,7 @@ scavenge_srt(const StgInfoTable *info)
* srt field in the info table. That's ok, because we'll
* never dereference it.
*/
srt = stgCast(StgClosure **,info->srt);
srt = (StgClosure **)(info->srt);
srt_end = srt + info->srt_len;
for (; srt < srt_end; srt++) {
/* Special-case to handle references to closures hiding out in DLLs, since
......@@ -1652,7 +1748,7 @@ scavenge_srt(const StgInfoTable *info)
closure that's fixed at link-time, and no extra magic is required.
*/
#ifdef ENABLE_WIN32_DLL_SUPPORT
if ( stgCast(unsigned long,*srt) & 0x1 ) {
if ( (unsigned long)(*srt) & 0x1 ) {
evacuate(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)));
} else {
evacuate(*srt);
......@@ -1740,7 +1836,7 @@ scavenge(step *step)
case BCO:
{
StgBCO* bco = stgCast(StgBCO*,p);
StgBCO* bco = (StgBCO *)p;
nat i;
for (i = 0; i < bco->n_ptrs; i++) {
bcoConstCPtr(bco,i) = evacuate(bcoConstCPtr(bco,i));
......@@ -1949,7 +2045,7 @@ scavenge(step *step)
* evacuate the function pointer too...
*/
{
StgPAP* pap = stgCast(StgPAP*,p);
StgPAP* pap = (StgPAP *)p;
pap->fun = evacuate(pap->fun);
scavenge_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
......@@ -1959,7 +2055,7 @@ scavenge(step *step)
case ARR_WORDS:
/* nothing to follow */
p += arr_words_sizeW(stgCast(StgArrWords*,p));
p += arr_words_sizeW((StgArrWords *)p);
break;
case MUT_ARR_PTRS:
......@@ -2620,7 +2716,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
if (! LOOKS_LIKE_GHC_INFO(q) ) {
#ifdef DEBUG
if ( 0 && LOOKS_LIKE_STATIC_CLOSURE(q) ) { /* Is it a static closure? */
ASSERT(closure_STATIC(stgCast(StgClosure*,q)));
ASSERT(closure_STATIC((StgClosure *)q));
}
/* otherwise, must be a pointer into the allocation space. */
#endif
......@@ -2819,7 +2915,7 @@ scavenge_large(step *step)
dbl_link_onto(bd, &step->scavenged_large_objects);
p = bd->start;
info = get_itbl(stgCast(StgClosure*,p));
info = get_itbl((StgClosure *)p);
switch (info->type) {
......@@ -2860,7 +2956,7 @@ scavenge_large(step *step)
case BCO:
{
StgBCO* bco = stgCast(StgBCO*,p);
StgBCO* bco = (StgBCO *)p;
nat i;
evac_gen = saved_evac_gen;
for (i = 0; i < bco->n_ptrs; i++) {
......@@ -2934,8 +3030,8 @@ void RevertCAFs(void)
enteredCAFs = caf->link;
ASSERT(get_itbl(caf)->type == CAF_ENTERED);
SET_INFO(caf,&CAF_UNENTERED_info);
caf->value = stgCast(StgClosure*,0xdeadbeef);
caf->link = stgCast(StgCAF*,0xdeadbeef);
caf->value = (StgClosure *)0xdeadbeef;
caf->link = (StgCAF *)0xdeadbeef;
}
enteredCAFs = END_CAF_LIST;
}
......@@ -3044,7 +3140,7 @@ threadLazyBlackHole(StgTSO *tso)
switch (get_itbl(update_frame)->type) {
case CATCH_FRAME:
update_frame = stgCast(StgCatchFrame*,update_frame)->link;
update_frame = ((StgCatchFrame *)update_frame)->link;
break;
case UPDATE_FRAME:
......@@ -3073,7 +3169,7 @@ threadLazyBlackHole(StgTSO *tso)
break;
case SEQ_FRAME:
update_frame = stgCast(StgSeqFrame*,update_frame)->link;
update_frame = ((StgSeqFrame *)update_frame)->link;
break;
case STOP_FRAME:
......
/* -----------------------------------------------------------------------------
* $Id: Prelude.c,v 1.2 2000/03/14 14:34:47 sewardj Exp $
* $Id: Prelude.c,v 1.3 2000/03/16 17:27:13 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
......@@ -18,6 +18,7 @@ const StgClosure *ind_unpackCString_closure;
const StgClosure *ind_stackOverflow_closure;
const StgClosure *ind_heapOverflow_closure;
const StgClosure *ind_PutFullMVar_static_closure;
const StgClosure *ind_BlockedOnDeadMVar_static_closure;
const StgClosure *ind_NonTermination_static_closure;
const StgClosure *ind_mainIO_closure;
......@@ -101,6 +102,7 @@ void fixupRTStoPreludeRefs ( void*(*ask_hugs_dynamic_linker)(char*) )
ind_True_static_closure = NULL; /* True_static_closure; */
ind_False_static_closure = NULL; /* False_static_closure; */
ind_PutFullMVar_static_closure = NULL; /* PutFullMVar_static_closure; */
ind_BlockedOnDeadMVar_static_closure = NULL; /* BlockedOnDeadMVar_static_closure; */
ind_NonTermination_static_closure = NULL; /* NonTermination_static_closure; */
ind_unpackCString_closure = NULL; /* unpackCString_closure; */
......@@ -135,6 +137,8 @@ void fixupRTStoPreludeRefs ( void*(*ask_hugs_dynamic_linker)(char*) )
= ask("PrelBase_False_static_closure");
ind_PutFullMVar_static_closure
= ask("PrelException_PutFullMVar_static_closure");
ind_BlockedOnDeadMVar_static_closure
= ask("PrelException_BlockedOnDeadMVar_static_closure");
ind_NonTermination_static_closure
= ask("PrelException_NonTermination_static_closure");
......
/* -----------------------------------------------------------------------------
* $Id: Prelude.h,v 1.4 2000/03/14 14:34:47 sewardj Exp $
* $Id: Prelude.h,v 1.5 2000/03/16 17:27:13 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
......@@ -20,9 +20,11 @@ extern DLL_IMPORT const StgClosure PrelBase_False_static_closure;
extern DLL_IMPORT const StgClosure PrelPack_unpackCString_closure;
extern DLL_IMPORT const StgClosure PrelException_stackOverflow_closure;
extern DLL_IMPORT const StgClosure PrelException_heapOverflow_closure;
extern const StgClosure PrelMain_mainIO_closure;
extern DLL_IMPORT const StgClosure PrelException_PutFullMVar_static_closure;
extern DLL_IMPORT const StgClosure PrelException_BlockedOnDeadMVar_static_closure;
extern DLL_IMPORT const StgClosure PrelException_NonTermination_static_closure;
extern const StgClosure PrelMain_mainIO_closure;
extern DLL_IMPORT const StgInfoTable PrelBase_Czh_static_info;
extern DLL_IMPORT const StgInfoTable PrelBase_Izh_static_info;
......@@ -46,6 +48,7 @@ extern DLL_IMPORT const StgInfoTable PrelStable_StablePtr_con_info;
#define stackOverflow_closure (&PrelException_stackOverflow_closure)
#define heapOverflow_closure (&PrelException_heapOverflow_closure)
#define PutFullMVar_closure (&PrelException_PutFullMVar_static_closure)
#define BlockedOnDeadMVar_closure (&PrelException_BlockedOnDeadMVar_static_closure)
#define NonTermination_closure (&PrelException_NonTermination_static_closure)
#define Czh_static_info (&PrelBase_Czh_static_info)
#define Izh_static_info (&PrelBase_Izh_static_info)
......@@ -77,6 +80,7 @@ extern const StgClosure *ind_unpackCString_closure;
extern const StgClosure *ind_stackOverflow_closure;
extern const StgClosure *ind_heapOverflow_closure;
extern const StgClosure *ind_PutFullMVar_static_closure;
extern const StgClosure *ind_BlockedOnDeadMVar_static_closure;
extern const StgClosure *ind_NonTermination_static_closure;
extern const StgInfoTable *ind_Czh_static_info;
......@@ -101,6 +105,7 @@ extern const StgInfoTable *ind_StablePtr_con_info;
#define stackOverflow_closure ind_stackOverflow_closure
#define heapOverflow_closure ind_heapOverflow_closure
#define PutFullMVar_closure ind_PutFullMVar_static_closure
#define BlockedOnDeadMVar_closure ind_BlockedOnDeadMVar_static_closure
#define NonTermination_closure ind_NonTermination_static_closure
#define Czh_static_info ind_Czh_static_info
#define Izh_static_info ind_Izh_static_info
......
/* ---------------------------------------------------------------------------
* $Id: Schedule.c,v 1.52 2000/03/14 09:55:05 simonmar Exp $
* $Id: Schedule.c,v 1.53 2000/03/16 17:27:13 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
......@@ -121,7 +121,6 @@ static StgMainThread *main_threads;
/* Thread queues.
* Locks required: sched_mutex.
*/
#if defined(GRAN)
StgTSO* ActiveTSO = NULL; /* for assigning system costs; GranSim-Light only */
......@@ -137,18 +136,19 @@ StgTSO* ActiveTSO = NULL; /* for assigning system costs; GranSim-Light only */
StgTSO *run_queue_hds[MAX_PROC], *run_queue_tls[MAX_PROC];
StgTSO *blocked_queue_hds[MAX_PROC], *blocked_queue_tls[MAX_PROC];
StgTSO *ccalling_threadss[MAX_PROC];
StgTSO *all_threadss[MAX_PROC];
#else /* !GRAN */
//@cindex run_queue_hd
//@cindex run_queue_tl
//@cindex blocked_queue_hd
//@cindex blocked_queue_tl
StgTSO *run_queue_hd, *run_queue_tl;
StgTSO *blocked_queue_hd, *blocked_queue_tl;
/* Linked list of all threads.
* Used for detecting garbage collected threads.
*/
StgTSO *all_threads;
/* Threads suspended in _ccall_GC.
* Locks required: sched_mutex.
*/
static StgTSO *suspended_ccalling_threads;
......@@ -312,6 +312,8 @@ schedule( void )
while (1) {
#endif
IF_DEBUG(scheduler, printAllThreads());
/* If we're interrupted (the user pressed ^C, or some other
* termination condition occurred), kill all the currently running
* threads.
......@@ -1022,12 +1024,11 @@ createThread_(nat size, rtsBool have_lock)
size = MIN_STACK_WORDS + TSO_STRUCT_SIZEW;
}
tso = (StgTSO *)allocate(size);
TICK_ALLOC_TSO(size-sizeofW(StgTSO),0);
stack_size = size - TSO_STRUCT_SIZEW;
// Hmm, this CCS_MAIN is not protected by a PROFILING cpp var;
tso = (StgTSO *)allocate(size);
TICK_ALLOC_TSO(size-TSO_STRUCT_SIZEW, 0);
SET_HDR(tso, &TSO_info, CCS_MAIN);
#if defined(GRAN)
SET_GRAN_HDR(tso, ThisPE);
......@@ -1035,10 +1036,9 @@ createThread_(nat size, rtsBool have_lock)
tso->whatNext = ThreadEnterGHC;
/* tso->id needs to be unique. For now we use a heavyweight mutex to
protect the increment operation on next_thread_id.
In future, we could use an atomic increment instead.
*/
* protect the increment operation on next_thread_id.
* In future, we could use an atomic increment instead.
*/
if (!have_lock) { ACQUIRE_LOCK(&sched_mutex); }
tso->id = next_thread_id++;
if (!have_lock) { RELEASE_LOCK(&sched_mutex); }
......@@ -1071,8 +1071,17 @@ createThread_(nat size, rtsBool have_lock)
insertThread(tso, CurrentProc);
#else
/* In a non-GranSim setup the pushing of a TSO onto the runq is separated
from its creation
*/
* from its creation
*/
#endif
/* Link the new thread on the global thread list.
*/
#if defined(GRAN)
#error ToDo
#else
tso->global_link = all_threads;
all_threads = tso;
#endif
#if defined(GRAN)
......@@ -1215,6 +1224,7 @@ initScheduler(void)
suspended_ccalling_threads = END_TSO_QUEUE;
main_threads = NULL;
all_threads = END_TSO_QUEUE;
context_switch = 0;
interrupted = 0;
......@@ -2324,6 +2334,41 @@ raiseAsync(StgTSO *tso, StgClosure *exception)
barf("raiseAsync");
}
/* -----------------------------------------------------------------------------
resurrectThreads is called after garbage collection on the list of
threads found to be garbage. Each of these threads will be woken
up and sent a signal: BlockedOnDeadMVar if the thread was blocked
on an MVar, or NonTermination if the thread was blocked on a Black
Hole.
-------------------------------------------------------------------------- */
void
resurrectThreads( StgTSO *threads )
{
StgTSO *tso, *next;
for (tso = threads; tso != END_TSO_QUEUE; tso = next) {
next = tso->global_link;
tso->global_link = all_threads;
all_threads = tso;
IF_DEBUG(scheduler, sched_belch("resurrecting thread %d", tso->id));
switch (tso->why_blocked) {
case BlockedOnMVar:
case BlockedOnException:
raiseAsync(tso,(StgClosure *)BlockedOnDeadMVar_closure);
break;
case BlockedOnBlackHole:
raiseAsync(tso,(StgClosure *)NonTermination_closure);
break;
case NotBlocked:
barf("resurrectThreads: thread not blocked");
default:
barf("resurrectThreads: thread blocked in a strange way");
}
}
}
//@node Debugging Routines, Index, Exception Handling Routines, Main scheduling code
//@subsection Debugging Routines
......@@ -2333,7 +2378,8 @@ raiseAsync(StgTSO *tso, StgClosure *exception)
#ifdef DEBUG
void printThreadBlockage(StgTSO *tso)
void
printThreadBlockage(StgTSO *tso)
{
switch (tso->why_blocked) {
case BlockedOnRead:
......@@ -2366,6 +2412,34 @@ void printThreadBlockage(StgTSO *tso)
}
}
void
printThreadStatus(StgTSO *tso)
{
switch (tso->whatNext) {
case ThreadKilled:
fprintf(stderr,"has been killed");
break;
case ThreadComplete:
fprintf(stderr,"has completed");
break;
default:
printThreadBlockage(tso);
}
}
void
printAllThreads(void)
{
StgTSO *t;
sched_belch("all threads:");
for (t = all_threads; t != END_TSO_QUEUE; t = t->global_link) {
fprintf(stderr, "\tthread %d is ", t->id);
printThreadStatus(t);
fprintf(stderr,"\n");
}
}
/*
Print a whole blocking queue attached to node (debugging only).
*/
......
/* -----------------------------------------------------------------------------
* $Id: Schedule.h,v 1.15 2000/01/14 14:06:48 hwloidl Exp $
* $Id: Schedule.h,v 1.16 2000/03/16 17:27:13 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
......@@ -103,12 +103,6 @@ void awaken_blocked_queue(StgTSO *q);
void initThread(StgTSO *tso, nat stack_size);
#endif
// debugging only
#ifdef DEBUG
extern void printThreadBlockage(StgTSO *tso);
#endif
void print_bq (StgClosure *node);
//@node Scheduler Vars and Data Types, Some convenient macros, Scheduler Functions
//@subsection Scheduler Vars and Data Types
......@@ -141,6 +135,7 @@ extern Capability MainRegTable;
*/
extern StgTSO *run_queue_hd, *run_queue_tl;
extern StgTSO *blocked_queue_hd, *blocked_queue_tl;
extern StgTSO *all_threads;
#ifdef SMP
//@cindex sched_mutex
......@@ -178,9 +173,20 @@ void interruptStgRts ( void );
void raiseAsync(StgTSO *tso, StgClosure *exception);
nat run_queue_len(void);
void resurrectThreads( StgTSO * );
//@node Some convenient macros, Index, Scheduler Vars and Data Types
//@subsection Some convenient macros
/* debugging only
*/
#ifdef DEBUG
void printThreadBlockage(StgTSO *tso);
void printThreadStatus(StgTSO *tso);
void printAllThreads(void);
#endif
void print_bq (StgClosure *node);
/* -----------------------------------------------------------------------------
* Some convenient macros...
*/
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment