Commit 30681e79 authored by simonmar's avatar simonmar

[project @ 1999-11-09 15:46:49 by simonmar]

A slew of SMP-related changes.

 - New locking scheme for thunks: we now check whether the thunk
   being entered is in our private allocation area, and if so
   we don't lock it.  Well, that's the upshot.  In practice it's
   a lot more fiddly than that.

 - I/O blocking is handled a bit more sanely now (but still not
   properly, methinks)

 - deadlock detection is back

 - remove old pre-SMP scheduler code

 - revamp the timing code.  We actually get reasonable-looking
   timing info for SMP programs now.

 - fix a bug in the garbage collector to do with IND_OLDGENs appearing
   on the mutable list of the old generation.

 - move BDescr() function from rts/BlockAlloc.h to includes/Block.h.

 - move struct generation and struct step into includes/StgStorage.h (sigh)

 - add UPD_IND_NOLOCK for updating with an indirection where locking
   the black hole is not required.
parent 532fc331
/* -----------------------------------------------------------------------------
* $Id: Block.h,v 1.5 1999/03/02 19:44:07 sof Exp $
* $Id: Block.h,v 1.6 1999/11/09 15:47:07 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -66,6 +66,16 @@ typedef struct _bdescr {
#define BDESCR_SHIFT 5
#endif
/* Finding the block descriptor for a given block -------------------------- */
static inline bdescr *Bdescr(StgPtr p)
{
return (bdescr *)
((((W_)p & MBLOCK_MASK & ~BLOCK_MASK) >> (BLOCK_SHIFT-BDESCR_SHIFT))
| ((W_)p & ~MBLOCK_MASK)
);
}
/* Useful Macros ------------------------------------------------------------ */
/* Offset of first real data block in a megablock */
......
/* -----------------------------------------------------------------------------
* $Id: Regs.h,v 1.5 1999/11/02 15:05:51 simonmar Exp $
* $Id: Regs.h,v 1.6 1999/11/09 15:47:08 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -49,8 +49,8 @@ typedef struct StgRegTable_ {
StgPtr rHp;
StgPtr rHpLim;
StgTSO *rCurrentTSO;
bdescr *rNursery;
bdescr *rCurrentNursery;
struct _bdescr *rNursery;
struct _bdescr *rCurrentNursery;
#ifdef SMP
struct StgRegTable_ *link;
#endif
......
/* -----------------------------------------------------------------------------
* $Id: Rts.h,v 1.8 1999/11/02 15:05:52 simonmar Exp $
* $Id: Rts.h,v 1.9 1999/11/09 15:47:08 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -11,7 +11,7 @@
#define RTS_H
#ifndef IN_STG_CODE
#define NOT_IN_STG_CODE
#define IN_STG_CODE 0
#endif
#include "Stg.h"
......
/* -----------------------------------------------------------------------------
* $Id: Stg.h,v 1.19 1999/11/05 12:28:05 simonmar Exp $
* $Id: Stg.h,v 1.20 1999/11/09 15:47:08 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -21,12 +21,12 @@
* with that. If "Stg.h" is included via "Rts.h", we're assumed to
* be in vanilla C.
*/
#ifdef NOT_IN_STG_CODE
#if ! IN_STG_CODE
# ifndef NO_REGS
# define NO_REGS /* don't define fixed registers */
# endif
#else
# define IN_STG_CODE
# define IN_STG_CODE 1
#endif
/* Configuration */
......@@ -113,13 +113,13 @@ void _stgAssert (char *, unsigned int);
#include "ClosureTypes.h"
#include "InfoTables.h"
#include "TSO.h"
#include "Block.h"
/* STG/Optimised-C related stuff */
#include "SMP.h"
#include "MachRegs.h"
#include "Regs.h"
#include "TailCalls.h"
#include "Block.h"
/* RTS public interface */
#include "RtsAPI.h"
......
/* -----------------------------------------------------------------------------
* $Id: StgMacros.h,v 1.16 1999/11/05 12:28:05 simonmar Exp $
* $Id: StgMacros.h,v 1.17 1999/11/09 15:47:09 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -418,13 +418,33 @@ EDI_(stg_gen_chk_info);
#ifdef EAGER_BLACKHOLING
# ifdef SMP
# define UPD_BH_UPDATABLE(info) \
TICK_UPD_BH_UPDATABLE(); \
LOCK_THUNK(info); \
# define UPD_BH_UPDATABLE(info) \
TICK_UPD_BH_UPDATABLE(); \
{ \
bdescr *bd = Bdescr(R1.p); \
if (bd->back != (bdescr *)BaseReg) { \
if (bd->gen->no >= 1 || bd->step->no >= 1) { \
LOCK_THUNK(info); \
} else { \
EXTFUN_RTS(stg_gc_enter_1_hponly); \
JMP_(stg_gc_enter_1_hponly); \
} \
} \
} \
SET_INFO(R1.cl,&BLACKHOLE_info)
# define UPD_BH_SINGLE_ENTRY(info) \
TICK_UPD_BH_SINGLE_ENTRY(); \
LOCK_THUNK(info); \
# define UPD_BH_SINGLE_ENTRY(info) \
TICK_UPD_BH_SINGLE_ENTRY(); \
{ \
bdescr *bd = Bdescr(R1.p); \
if (bd->back != (bdescr *)BaseReg) { \
if (bd->gen->no >= 1 || bd->step->no >= 1) { \
LOCK_THUNK(info); \
} else { \
EXTFUN_RTS(stg_gc_enter_1_hponly); \
JMP_(stg_gc_enter_1_hponly); \
} \
} \
} \
SET_INFO(R1.cl,&BLACKHOLE_info)
# else
# define UPD_BH_UPDATABLE(info) \
......
/* -----------------------------------------------------------------------------
* $Id: StgStorage.h,v 1.5 1999/11/02 15:05:53 simonmar Exp $
* $Id: StgStorage.h,v 1.6 1999/11/09 15:47:09 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -10,6 +10,79 @@
#ifndef STGSTORAGE_H
#define STGSTORAGE_H
/* GENERATION GC NOTES
*
* We support an arbitrary number of generations, with an arbitrary number
* of steps per generation. Notes (in no particular order):
*
* - all generations except the oldest should have two steps. This gives
* objects a decent chance to age before being promoted, and in
* particular will ensure that we don't end up with too many
* thunks being updated in older generations.
*
* - the oldest generation has one step. There's no point in aging
* objects in the oldest generation.
*
* - generation 0, step 0 (G0S0) is the allocation area. It is given
* a fixed set of blocks during initialisation, and these blocks
* are never freed.
*
* - during garbage collection, each step which is an evacuation
* destination (i.e. all steps except G0S0) is allocated a to-space.
* evacuated objects are allocated into the step's to-space until
* GC is finished, when the original step's contents may be freed
* and replaced by the to-space.
*
* - the mutable-list is per-generation (not per-step). G0 doesn't
* have one (since every garbage collection collects at least G0).
*
* - block descriptors contain pointers to both the step and the
* generation that the block belongs to, for convenience.
*
* - static objects are stored in per-generation lists. See GC.c for
* details of how we collect CAFs in the generational scheme.
*
* - large objects are per-step, and are promoted in the same way
* as small objects, except that we may allocate large objects into
* generation 1 initially.
*/
typedef struct _step {
unsigned int no; /* step number */
bdescr *blocks; /* blocks in this step */
unsigned int n_blocks; /* number of blocks */
struct _step *to; /* where collected objects from this step go */
struct _generation *gen; /* generation this step belongs to */
bdescr *large_objects; /* large objects (doubly linked) */
/* temporary use during GC: */
StgPtr hp; /* next free locn in to-space */
StgPtr hpLim; /* end of current to-space block */
bdescr *hp_bd; /* bdescr of current to-space block */
bdescr *to_space; /* bdescr of first to-space block */
unsigned int to_blocks; /* number of blocks in to-space */
bdescr *scan_bd; /* block currently being scanned */
StgPtr scan; /* scan pointer in current block */
bdescr *new_large_objects; /* large objects collected so far */
bdescr *scavenged_large_objects; /* live large objects after GC (dbl link) */
} step;
typedef struct _generation {
unsigned int no; /* generation number */
step *steps; /* steps */
unsigned int n_steps; /* number of steps */
unsigned int max_blocks; /* max blocks in step 0 */
StgMutClosure *mut_list; /* mutable objects in this generation (not G0)*/
StgMutClosure *mut_once_list; /* objects that point to younger generations */
/* temporary use during GC: */
StgMutClosure *saved_mut_list;
/* stats information */
unsigned int collections;
unsigned int failed_promotions;
} generation;
/* -----------------------------------------------------------------------------
Allocation area for compiled code
......
/* -----------------------------------------------------------------------------
* $Id: Updates.h,v 1.14 1999/11/02 15:05:53 simonmar Exp $
* $Id: Updates.h,v 1.15 1999/11/09 15:47:09 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -36,30 +36,55 @@
if you *really* need an IND use UPD_REAL_IND
*/
#ifdef SMP
#define UPD_REAL_IND(updclosure, heapptr) \
{ \
const StgInfoTable *info; \
if (Bdescr((P_)updclosure)->back != (bdescr *)BaseReg) { \
info = LOCK_CLOSURE(updclosure); \
} else { \
info = updclosure->header.info; \
} \
AWAKEN_BQ(info,updclosure); \
updateWithIndirection(info, \
(StgClosure *)updclosure, \
(StgClosure *)heapptr); \
}
#else
#define UPD_REAL_IND(updclosure, heapptr) \
{ \
const StgInfoTable *info; \
info = LOCK_CLOSURE(updclosure); \
\
if (info == &BLACKHOLE_BQ_info) { \
STGCALL1(awakenBlockedQueue, \
((StgBlockingQueue *)updclosure)->blocking_queue); \
} \
updateWithIndirection((StgClosure *)updclosure, \
(StgClosure *)heapptr); \
info = ((StgClosure *)updclosure)->header.info; \
AWAKEN_BQ(info,updclosure); \
updateWithIndirection(info, \
(StgClosure *)updclosure, \
(StgClosure *)heapptr); \
}
#else
#define UPD_REAL_IND(updclosure, heapptr) \
AWAKEN_BQ(updclosure); \
updateWithIndirection((StgClosure *)updclosure, \
(StgClosure *)heapptr);
#endif
#if defined(PROFILING) || defined(TICKY_TICKY)
#define UPD_PERM_IND(updclosure, heapptr) \
AWAKEN_BQ(updclosure); \
updateWithPermIndirection((StgClosure *)updclosure, \
(StgClosure *)heapptr);
#define UPD_PERM_IND(updclosure, heapptr) \
{ \
const StgInfoTable *info; \
info = ((StgClosure *)updclosure)->header.info; \
AWAKEN_BQ(info,updclosure); \
updateWithPermIndirection(info, \
(StgClosure *)updclosure, \
(StgClosure *)heapptr); \
}
#endif
#ifdef SMP
#define UPD_IND_NOLOCK(updclosure, heapptr) \
{ \
const StgInfoTable *info; \
info = updclosure->header.info; \
AWAKEN_BQ(info,updclosure); \
updateWithIndirection(info, \
(StgClosure *)updclosure, \
(StgClosure *)heapptr); \
}
#else
#define UPD_IND_NOLOCK(updclosure,heapptr) UPD_IND(updclosure,heapptr)
#endif
/* -----------------------------------------------------------------------------
......@@ -68,10 +93,10 @@
extern void awakenBlockedQueue(StgTSO *q);
#define AWAKEN_BQ(closure) \
if (closure->header.info == &BLACKHOLE_BQ_info) { \
STGCALL1(awakenBlockedQueue, \
((StgBlockingQueue *)closure)->blocking_queue); \
#define AWAKEN_BQ(info,closure) \
if (info == &BLACKHOLE_BQ_info) { \
STGCALL1(awakenBlockedQueue, \
((StgBlockingQueue *)closure)->blocking_queue); \
}
......
/* -----------------------------------------------------------------------------
* $Id: BlockAlloc.h,v 1.7 1999/11/02 17:08:28 simonmar Exp $
* $Id: BlockAlloc.h,v 1.8 1999/11/09 15:46:49 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -24,16 +24,6 @@ extern bdescr *allocBlock(void);
extern void freeGroup(bdescr *p);
extern void freeChain(bdescr *p);
/* Finding the block descriptor for a given block -------------------------- */
static inline bdescr *Bdescr(StgPtr p)
{
return (bdescr *)
((((W_)p & MBLOCK_MASK & ~BLOCK_MASK) >> (BLOCK_SHIFT-BDESCR_SHIFT))
| ((W_)p & ~MBLOCK_MASK)
);
}
/* Round a value to megablocks --------------------------------------------- */
#define WORDS_PER_MBLOCK (BLOCKS_PER_MBLOCK * BLOCK_SIZE_W)
......
/* -----------------------------------------------------------------------------
* $Id: ClosureFlags.c,v 1.3 1999/11/02 15:05:56 simonmar Exp $
* $Id: ClosureFlags.c,v 1.4 1999/11/09 15:46:49 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
......@@ -54,7 +54,7 @@ StgWord16 closure_flags[] = {
/* IND_STATIC */ ( _STA ),
/* CAF_UNENTERED */ ( 0 ),
/* CAF_ENTERED */ ( 0 ),
/* BLACKHOLE_BQ */ ( _BTM|_NS| _MUT|_UPT ),
/* CAF_BLACKHOLE */ ( _BTM|_NS| _MUT|_UPT ),
/* RET_BCO */ ( _BTM ),
/* RET_SMALL */ ( _BTM| _SRT),
/* RET_VEC_SMALL */ ( _BTM| _SRT),
......@@ -65,7 +65,7 @@ StgWord16 closure_flags[] = {
/* CATCH_FRAME */ ( _BTM ),
/* STOP_FRAME */ ( _BTM ),
/* SEQ_FRAME */ ( _BTM ),
/* BLACKHOLE */ ( _NS| _UPT ),
/* BLACKHOLE */ ( _NS| _MUT|_UPT ),
/* BLACKHOLE_BQ */ ( _NS| _MUT|_UPT ),
/* SE_BLACKHOLE */ ( _NS| _UPT ),
/* SE_CAF_BLACKHOLE */ ( _NS| _UPT ),
......
/* -----------------------------------------------------------------------------
* $Id: GC.c,v 1.65 1999/11/02 15:05:56 simonmar Exp $
* $Id: GC.c,v 1.66 1999/11/09 15:46:49 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
......@@ -2204,9 +2204,30 @@ scavenge_mutable_list(generation *gen)
continue;
}
/* Happens if a BLACKHOLE_BQ in the old generation is updated:
*/
case IND_OLDGEN:
case IND_OLDGEN_PERM:
/* Try to pull the indirectee into this generation, so we can
* remove the indirection from the mutable list.
*/
evac_gen = gen->no;
((StgIndOldGen *)p)->indirectee =
evacuate(((StgIndOldGen *)p)->indirectee);
evac_gen = 0;
if (failed_to_evac) {
failed_to_evac = rtsFalse;
p->mut_link = gen->mut_once_list;
gen->mut_once_list = p;
} else {
p->mut_link = NULL;
}
continue;
default:
/* shouldn't have anything else on the mutables list */
barf("scavenge_mut_list: strange object? %d", (int)(info->type));
barf("scavenge_mutable_list: strange object? %d", (int)(info->type));
}
}
}
......@@ -2894,7 +2915,7 @@ threadSqueezeStack(StgTSO *tso)
* sorted out? oh yes: we aren't counting each enter properly
* in this case. See the log somewhere. KSW 1999-04-21
*/
UPD_IND(updatee_bypass, updatee_keep); /* this wakes the threads up */
UPD_IND_NOLOCK(updatee_bypass, updatee_keep); /* this wakes the threads up */
sp = (P_)frame - 1; /* sp = stuff to slide */
displacement += sizeofW(StgUpdateFrame);
......
/* -----------------------------------------------------------------------------
* $Id: HeapStackCheck.hc,v 1.9 1999/08/25 16:11:48 simonmar Exp $
* $Id: HeapStackCheck.hc,v 1.10 1999/11/09 15:46:51 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -159,6 +159,18 @@ EXTFUN(stg_gc_enter_1)
FE_
}
EXTFUN(stg_gc_enter_1_hponly)
{
FB_
Sp -= 1;
Sp[0] = R1.w;
R1.i = HeapOverflow;
SaveThreadState();
CurrentTSO->whatNext = ThreadEnterGHC;
JMP_(StgReturn);
FE_
}
/*- 2 Regs--------------------------------------------------------------------*/
EXTFUN(stg_gc_enter_2)
......
/* -----------------------------------------------------------------------------
* $Id: PrimOps.hc,v 1.33 1999/11/02 15:05:58 simonmar Exp $
* $Id: PrimOps.hc,v 1.34 1999/11/09 15:46:53 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -1028,13 +1028,15 @@ FN_(delayzh_fast)
ASSERT(CurrentTSO->why_blocked == NotBlocked);
CurrentTSO->why_blocked = BlockedOnDelay;
ACQUIRE_LOCK(&sched_mutex);
/* Add on ticks_since_select, since these will be subtracted at
* the next awaitEvent call.
*/
CurrentTSO->block_info.delay = R1.i + ticks_since_select;
ACQUIRE_LOCK(&sched_mutex);
APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
RELEASE_LOCK(&sched_mutex);
JMP_(stg_block_noregs);
FE_
......
/* -----------------------------------------------------------------------------
* $Id: Schedule.c,v 1.30 1999/11/08 15:30:39 sewardj Exp $
* $Id: Schedule.c,v 1.31 1999/11/09 15:46:54 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -87,10 +87,6 @@ StgTSO *blocked_queue_hd, *blocked_queue_tl;
*/
static StgTSO *suspended_ccalling_threads;
#ifndef SMP
static rtsBool in_ccall_gc;
#endif
static void GetRoots(void);
static StgTSO *threadStackOverflow(StgTSO *tso);
......@@ -192,12 +188,19 @@ schedule( void )
while (1) {
/* Check whether any waiting threads need to be woken up.
* If the run queue is empty, we can wait indefinitely for
* something to happen.
/* Check whether any waiting threads need to be woken up. If the
* run queue is empty, and there are no other tasks running, we
* can wait indefinitely for something to happen.
* ToDo: what if another client comes along & requests another
* main thread?
*/
if (blocked_queue_hd != END_TSO_QUEUE) {
awaitEvent(run_queue_hd == END_TSO_QUEUE);
awaitEvent(
(run_queue_hd == END_TSO_QUEUE)
#ifdef SMP
&& (n_free_capabilities == RtsFlags.ConcFlags.nNodes)
#endif
);
}
/* check for signals each time around the scheduler */
......@@ -207,6 +210,35 @@ schedule( void )
}
#endif
/* Detect deadlock: when we have no threads to run, there are
* no threads waiting on I/O or sleeping, and all the other
* tasks are waiting for work, we must have a deadlock. Inform
* all the main threads.
*/
#ifdef SMP
if (blocked_queue_hd == END_TSO_QUEUE
&& run_queue_hd == END_TSO_QUEUE
&& (n_free_capabilities == RtsFlags.ConcFlags.nNodes)
) {
StgMainThread *m;
for (m = main_threads; m != NULL; m = m->link) {
m->ret = NULL;
m->stat = Deadlock;
pthread_cond_broadcast(&m->wakeup);
}
main_threads = NULL;
}
#else /* ! SMP */
if (blocked_queue_hd == END_TSO_QUEUE
&& run_queue_hd == END_TSO_QUEUE) {
StgMainThread *m = main_threads;
m->ret = NULL;
m->stat = Deadlock;
main_threads = m->link;
return;
}
#endif
#ifdef SMP
/* If there's a GC pending, don't do anything until it has
* completed.
......@@ -249,11 +281,11 @@ schedule( void )
/* set the context_switch flag
*/
if (run_queue_hd == END_TSO_QUEUE)
if (run_queue_hd == END_TSO_QUEUE)
context_switch = 0;
else
context_switch = 1;
RELEASE_LOCK(&sched_mutex);
#ifdef SMP
......@@ -711,17 +743,7 @@ taskStart( void *arg STG_UNUSED )
static void
term_handler(int sig STG_UNUSED)
{
nat i;
pthread_t me = pthread_self();
for (i = 0; i < RtsFlags.ConcFlags.nNodes; i++) {
if (task_ids[i].id == me) {
task_ids[i].mut_time = usertime() - task_ids[i].gc_time;
if (task_ids[i].mut_time < 0.0) {
task_ids[i].mut_time = 0.0;
}
}
}
stat_workerStop();
ACQUIRE_LOCK(&term_mutex);
await_death--;
RELEASE_LOCK(&term_mutex);
......@@ -798,6 +820,11 @@ startTasks( void )
barf("startTasks: Can't create new Posix thread");
}
task_ids[i].id = tid;
task_ids[i].mut_time = 0.0;
task_ids[i].mut_etime = 0.0;
task_ids[i].gc_time = 0.0;
task_ids[i].gc_etime = 0.0;
task_ids[i].elapsedtimestart = elapsedtime();
IF_DEBUG(scheduler,fprintf(stderr,"schedule: Started task: %ld\n",tid););
}
}
......@@ -884,14 +911,19 @@ waitThread(StgTSO *tso, /*out*/StgClosure **ret)
m->link = main_threads;
main_threads = m;
IF_DEBUG(scheduler, fprintf(stderr, "schedule: new main thread (%d)\n",
m->tso->id));
#ifdef SMP
pthread_cond_wait(&m->wakeup, &sched_mutex);
do {
pthread_cond_wait(&m->wakeup, &sched_mutex);
} while (m->stat == NoStatus);
#else
schedule();
ASSERT(m->stat != NoStatus);
#endif
stat = m->stat;
ASSERT(stat != NoStatus);
#ifdef SMP
pthread_cond_destroy(&m->wakeup);
......@@ -902,253 +934,6 @@ waitThread(StgTSO *tso, /*out*/StgClosure **ret)
return stat;
}
#if 0
SchedulerStatus schedule(StgTSO *main, StgClosure **ret_val)
{
StgTSO *t;
StgThreadReturnCode ret;
StgTSO **MainTSO;
rtsBool in_ccall_gc;
/* Return value is NULL by default, it is only filled in if the
* main thread completes successfully.
*/
if (ret_val) { *ret_val = NULL; }
/* Save away a pointer to the main thread so that we can keep track
* of it should a garbage collection happen. We keep a stack of
* main threads in order to support scheduler re-entry. We can't
* use the normal TSO linkage for this stack, because the main TSO
* may need to be linked onto other queues.
*/
main_threads[next_main_thread] = main;
MainTSO = &main_threads[next_main_thread];
next_main_thread++;
IF_DEBUG(scheduler,
fprintf(stderr, "Scheduler entered: nesting = %d\n",
next_main_thread););