Commit b933b469 authored by simonmar's avatar simonmar
Browse files

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

Add 'par' and sparking support to the SMP implementation.
parent b034fbda
/* -----------------------------------------------------------------------------
* $Id: PrimOps.h,v 1.42 2000/01/07 10:27:33 sewardj Exp $
* $Id: PrimOps.h,v 1.43 2000/01/12 15:15:17 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -734,6 +734,19 @@ EF_(unblockAsyncExceptionszh_fast);
extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2);
#if defined(SMP) || defined(PAR)
#define parzh(r,node) \
{ \
if (closure_SHOULD_SPARK((StgClosure *)node) && \
SparkTl < SparkLim) { \
*SparkTl++ = (StgClosure *)(node); \
} \
r = 1; \
}
#else
#define parzh(r,node) r = 1
#endif
/* Hmm, I'll think about these later. */
/* -----------------------------------------------------------------------------
Pointer equality
......
/* -----------------------------------------------------------------------------
* $Id: Regs.h,v 1.7 1999/11/09 15:57:39 simonmar Exp $
* $Id: Regs.h,v 1.8 2000/01/12 15:15:17 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -25,6 +25,13 @@
* 2) caller-saves registers are saved across a CCall
*/
typedef struct StgSparkPool_ {
StgClosure **base;
StgClosure **lim;
StgClosure **hd;
StgClosure **tl;
} StgSparkPool;
typedef struct StgRegTable_ {
StgUnion rR1;
StgUnion rR2;
......@@ -51,8 +58,11 @@ typedef struct StgRegTable_ {
StgTSO *rCurrentTSO;
struct _bdescr *rNursery;
struct _bdescr *rCurrentNursery;
#ifdef SMP
struct StgRegTable_ *link;
#if defined(SMP) || defined(PAR)
StgSparkPool rSparks; /* per-task spark pool */
#endif
#if defined(SMP)
struct StgRegTable_ *link; /* per-task register tables are linked together */
#endif
} StgRegTable;
......@@ -103,6 +113,12 @@ extern DLL_IMPORT_RTS StgRegTable MainRegTable;
#define SAVE_CurrentTSO (BaseReg->rCurrentTSO)
#define SAVE_CurrentNursery (BaseReg->rCurrentNursery)
#if defined(SMP) || defined(PAR)
#define SAVE_SparkHd (BaseReg->rSparks.hd)
#define SAVE_SparkTl (BaseReg->rSparks.tl)
#define SAVE_SparkBase (BaseReg->rSparks.base)
#define SAVE_SparkLim (BaseReg->rSparks.lim)
#endif
/* We sometimes need to save registers across a C-call, eg. if they
* are clobbered in the standard calling convention. We define the
......@@ -304,6 +320,30 @@ GLOBAL_REG_DECL(bdescr *,CurrentNursery,REG_CurrentNursery)
#define CurrentNursery (BaseReg->rCurrentNursery)
#endif
#ifdef REG_SparkHd
GLOBAL_REG_DECL(bdescr *,SparkHd,REG_SparkHd)
#else
#define SparkHd (BaseReg->rSparks.hd)
#endif
#ifdef REG_SparkTl
GLOBAL_REG_DECL(bdescr *,SparkTl,REG_SparkTl)
#else
#define SparkTl (BaseReg->rSparks.tl)
#endif
#ifdef REG_SparkBase
GLOBAL_REG_DECL(bdescr *,SparkBase,REG_SparkBase)
#else
#define SparkBase (BaseReg->rSparks.base)
#endif
#ifdef REG_SparkLim
GLOBAL_REG_DECL(bdescr *,SparkLim,REG_SparkLim)
#else
#define SparkLim (BaseReg->rSparks.lim)
#endif
/* -----------------------------------------------------------------------------
For any registers which are denoted "caller-saves" by the C calling
convention, we have to emit code to save and restore them across C
......@@ -513,6 +553,38 @@ GLOBAL_REG_DECL(bdescr *,CurrentNursery,REG_CurrentNursery)
#define CALLER_RESTORE_CurrentNursery /* nothing */
#endif
#ifdef CALLER_SAVES_SparkHd
#define CALLER_SAVE_SparkHd SAVE_SparkHd = SparkHd;
#define CALLER_RESTORE_SparkHd SparkHd = SAVE_SparkHd;
#else
#define CALLER_SAVE_SparkHd /* nothing */
#define CALLER_RESTORE_SparkHd /* nothing */
#endif
#ifdef CALLER_SAVES_SparkTl
#define CALLER_SAVE_SparkTl SAVE_SparkTl = SparkTl;
#define CALLER_RESTORE_SparkTl SparkTl = SAVE_SparkTl;
#else
#define CALLER_SAVE_SparkTl /* nothing */
#define CALLER_RESTORE_SparkTl /* nothing */
#endif
#ifdef CALLER_SAVES_SparkBase
#define CALLER_SAVE_SparkBase SAVE_SparkBase = SparkBase;
#define CALLER_RESTORE_SparkBase SparkBase = SAVE_SparkBase;
#else
#define CALLER_SAVE_SparkBase /* nothing */
#define CALLER_RESTORE_SparkBase /* nothing */
#endif
#ifdef CALLER_SAVES_SparkLim
#define CALLER_SAVE_SparkLim SAVE_SparkLim = SparkLim;
#define CALLER_RESTORE_SparkLim SparkLim = SAVE_SparkLim;
#else
#define CALLER_SAVE_SparkLim /* nothing */
#define CALLER_RESTORE_SparkLim /* nothing */
#endif
#endif /* IN_STG_CODE */
/* ----------------------------------------------------------------------------
......@@ -545,7 +617,11 @@ GLOBAL_REG_DECL(bdescr *,CurrentNursery,REG_CurrentNursery)
CALLER_SAVE_Hp \
CALLER_SAVE_HpLim \
CALLER_SAVE_CurrentTSO \
CALLER_SAVE_CurrentNursery
CALLER_SAVE_CurrentNursery \
CALLER_SAVE_SparkHd \
CALLER_SAVE_SparkTl \
CALLER_SAVE_SparkBase \
CALLER_SAVE_SparkLim
#define CALLER_RESTORE_USER \
CALLER_RESTORE_R1 \
......@@ -572,7 +648,11 @@ GLOBAL_REG_DECL(bdescr *,CurrentNursery,REG_CurrentNursery)
CALLER_RESTORE_Hp \
CALLER_RESTORE_HpLim \
CALLER_RESTORE_CurrentTSO \
CALLER_RESTORE_CurrentNursery
CALLER_RESTORE_CurrentNursery \
CALLER_RESTORE_SparkHd \
CALLER_RESTORE_SparkTl \
CALLER_RESTORE_SparkBase \
CALLER_RESTORE_SparkLim
#else /* not IN_STG_CODE */
......
/* -----------------------------------------------------------------------------
* $Id: Rts.h,v 1.9 1999/11/09 15:47:08 simonmar Exp $
* $Id: Rts.h,v 1.10 2000/01/12 15:15:17 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -47,10 +47,22 @@ typedef enum {
Assertions and Debuggery
-------------------------------------------------------------------------- */
#ifndef DEBUG
#ifdef DEBUG
#define IF_DEBUG(c,s) if (RtsFlags.DebugFlags.c) { s; }
#else
#define IF_DEBUG(c,s) doNothing()
#endif
#if defined(GRAN) && defined(DEBUG)
#define IF_GRAN_DEBUG(c,s) if (RtsFlags.GranFlags.Debug.c) { s; }
#else
#define IF_DEBUG(c,s) if (RtsFlags.DebugFlags.c) { s; }
#define IF_GRAN_DEBUG(c,s) doNothing()
#endif
#if defined(PAR) && defined(DEBUG)
#define IF_PAR_DEBUG(c,s) if (RtsFlags.ParFlags.Debug.c) { s; }
#else
#define IF_PAR_DEBUG(c,s) doNothing()
#endif
/* -----------------------------------------------------------------------------
......
/* -----------------------------------------------------------------------------
* $Id: RtsFlags.c,v 1.21 1999/11/29 12:02:44 keithw Exp $
* $Id: RtsFlags.c,v 1.22 2000/01/12 15:15:17 simonmar Exp $
*
* (c) The AQUA Project, Glasgow University, 1994-1997
* (c) The GHC Team, 1998-1999
......@@ -103,19 +103,22 @@ void initRtsFlagsDefaults(void)
#endif
RtsFlags.ConcFlags.ctxtSwitchTime = CS_MIN_MILLISECS; /* In milliseconds */
#ifdef SMP
RtsFlags.ConcFlags.nNodes = 1;
RtsFlags.ParFlags.nNodes = 1;
#endif
#ifdef PAR
RtsFlags.ParFlags.parallelStats = rtsFalse;
RtsFlags.ParFlags.granSimStats = rtsFalse;
RtsFlags.ParFlags.granSimStats_Binary = rtsFalse;
RtsFlags.ParFlags.outputDisabled = rtsFalse;
RtsFlags.ParFlags.packBufferSize = 1024;
#endif
#if defined(PAR) || defined(SMP)
RtsFlags.ParFlags.maxLocalSparks = 4096;
#endif /* PAR */
#endif
#ifdef GRAN
RtsFlags.GranFlags.granSimStats = rtsFalse;
......@@ -281,6 +284,9 @@ usage_text[] = {
" -qb Enable binary activity profile (output file /tmp/<program>.gb)",
" -Q<size> Set pack-buffer size (default: 1024)",
# endif
# if defined(SMP) || defined(PAR)
" -e<n> Maximum number of outstanding local sparks (default: 4096)",
#endif
# ifdef PAR
" -d Turn on PVM-ish debugging",
" -O Disable output for performance measurement",
......@@ -354,8 +360,7 @@ setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[])
for (arg = 0; arg < *rts_argc; arg++) {
if (rts_argv[arg][0] != '-') {
fflush(stdout);
fprintf(stderr, "setupRtsFlags: Unexpected RTS argument: %s\n",
rts_argv[arg]);
prog_belch("unexpected RTS argument: %s", rts_argv[arg]);
error = rtsTrue;
} else {
......@@ -373,7 +378,7 @@ setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[])
# define TICKY_BUILD_ONLY(x) x
#else
# define TICKY_BUILD_ONLY(x) \
fprintf(stderr, "setupRtsFlags: GHC not built for: ticky-ticky stats\n"); \
prog_belch("GHC not built for: ticky-ticky stats"); \
error = rtsTrue;
#endif
......@@ -381,7 +386,7 @@ error = rtsTrue;
# define COST_CENTRE_USING_BUILD_ONLY(x) x
#else
# define COST_CENTRE_USING_BUILD_ONLY(x) \
fprintf(stderr, "setupRtsFlags: GHC not built for: -prof or -parallel\n"); \
prog_belch("GHC not built for: -prof or -parallel"); \
error = rtsTrue;
#endif
......@@ -389,7 +394,15 @@ error = rtsTrue;
# define PROFILING_BUILD_ONLY(x) x
#else
# define PROFILING_BUILD_ONLY(x) \
fprintf(stderr, "setupRtsFlags: GHC not built for: -prof\n"); \
prog_belch("GHC not built for: -prof"); \
error = rtsTrue;
#endif
#ifdef SMP
# define SMP_BUILD_ONLY(x) x
#else
# define SMP_BUILD_ONLY(x) \
prog_belch("GHC not built for: -parallel"); \
error = rtsTrue;
#endif
......@@ -397,7 +410,15 @@ error = rtsTrue;
# define PAR_BUILD_ONLY(x) x
#else
# define PAR_BUILD_ONLY(x) \
fprintf(stderr, "setupRtsFlags: GHC not built for: -parallel\n"); \
prog_belch("GHC not built for: -parallel"); \
error = rtsTrue;
#endif
#if defined(SMP) || defined(PAR)
# define PAR_OR_SMP_BUILD_ONLY(x) x
#else
# define PAR_OR_SMP_BUILD_ONLY(x) \
prog_belch("GHC not built for: -parallel or -smp"); \
error = rtsTrue;
#endif
......@@ -405,7 +426,7 @@ error = rtsTrue;
# define GRAN_BUILD_ONLY(x) x
#else
# define GRAN_BUILD_ONLY(x) \
fprintf(stderr, "setupRtsFlags: GHC not built for: -gransim\n"); \
prog_belch("GHC not built for: -gransim"); \
error = rtsTrue;
#endif
......@@ -580,8 +601,7 @@ error = rtsTrue;
RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CLOSURE_TYPE;
break;
default:
fprintf(stderr, "Invalid heap profile option: %s\n",
rts_argv[arg]);
prog_belch("invalid heap profile option: %s",rts_argv[arg]);
error = rtsTrue;
}
#else
......@@ -620,8 +640,7 @@ error = rtsTrue;
}
break;
default:
fprintf(stderr, "Invalid heap profile option: %s\n",
rts_argv[arg]);
prog_belch("invalid heap profile option: %s",rts_argv[arg]);
error = rtsTrue;
}
)
......@@ -634,40 +653,42 @@ error = rtsTrue;
case CCchar:
max_cc_no = (hash_t) decode(rts_argv[arg]+3);
if (max_cc_no == 0) {
fprintf(stderr, "Bad number of cost centres %s\n", rts_argv[arg]);
prog_belch("bad number of cost centres %s", rts_argv[arg]);
error = rtsTrue;
}
break;
case MODchar:
max_mod_no = (hash_t) decode(rts_argv[arg]+3);
if (max_mod_no == 0) {
fprintf(stderr, "Bad number of modules %s\n", rts_argv[arg]);
prog_belch("bad number of modules %s", rts_argv[arg]);
error = rtsTrue;
}
break;
case GRPchar:
max_grp_no = (hash_t) decode(rts_argv[arg]+3);
if (max_grp_no == 0) {
fprintf(stderr, "Bad number of groups %s\n", rts_argv[arg]);
prog_belch("bad number of groups %s", rts_argv[arg]);
error = rtsTrue;
}
break;
case DESCRchar:
max_descr_no = (hash_t) decode(rts_argv[arg]+3);
if (max_descr_no == 0) {
fprintf(stderr, "Bad number of closure descriptions %s\n", rts_argv[arg]);
prog_belch("bad number of closure descriptions %s",
rts_argv[arg]);
error = rtsTrue;
}
break;
case TYPEchar:
max_type_no = (hash_t) decode(rts_argv[arg]+3);
if (max_type_no == 0) {
fprintf(stderr, "Bad number of type descriptions %s\n", rts_argv[arg]);
prog_belch("bad number of type descriptions %s",
rts_argv[arg]);
error = rtsTrue;
}
break;
default:
fprintf(stderr, "Invalid index table size option: %s\n",
prog_belch("invalid index table size option: %s",
rts_argv[arg]);
error = rtsTrue;
}
......@@ -684,7 +705,8 @@ error = rtsTrue;
if (! left || ! right ||
strrchr(rts_argv[arg], '{') != left ||
strchr(rts_argv[arg], '}') != right) {
fprintf(stderr, "Invalid heap profiling selection bracketing\n %s\n", rts_argv[arg]);
prog_belch("invalid heap profiling selection bracketing: %s",
rts_argv[arg]);
error = rtsTrue;
} else {
*right = '\0';
......@@ -730,26 +752,25 @@ error = rtsTrue;
#ifdef SMP
case 'N':
SMP_BUILD_ONLY(
if (rts_argv[arg][2] != '\0') {
RtsFlags.ConcFlags.nNodes
RtsFlags.ParFlags.nNodes
= strtol(rts_argv[arg]+2, (char **) NULL, 10);
if (RtsFlags.ConcFlags.nNodes <= 0) {
fprintf(stderr, "setupRtsFlags: bad value for -N\n");
if (RtsFlags.ParFlags.nNodes <= 0) {
prog_belch("bad value for -N");
error = rtsTrue;
}
}
break;
) break;
#endif
/* =========== PARALLEL =========================== */
case 'e':
PAR_BUILD_ONLY(
if (rts_argv[arg][2] != '\0') { /* otherwise, stick w/ the default */
PAR_OR_SMP_BUILD_ONLY(
if (rts_argv[arg][2] != '\0') {
RtsFlags.ParFlags.maxLocalSparks
= strtol(rts_argv[arg]+2, (char **) NULL, 10);
if (RtsFlags.ParFlags.maxLocalSparks <= 0) {
fprintf(stderr, "setupRtsFlags: bad value for -e\n");
prog_belch("bad value for -e");
error = rtsTrue;
}
}
......@@ -783,7 +804,7 @@ error = rtsTrue;
if (rts_argv[arg][2] != '\0') {
RtsFlags.ParFlags.packBufferSize = decode(rts_argv[arg]+2);
} else {
fprintf(stderr, "setupRtsFlags: missing size of PackBuffer (for -Q)\n");
prog_belch("missing size of PackBuffer (for -Q)");
error = rtsTrue;
}
) break;
......@@ -813,7 +834,7 @@ error = rtsTrue;
case 'x': /* Extend the argument space */
switch(rts_argv[arg][2]) {
case '\0':
fprintf(stderr, "setupRtsFlags: Incomplete RTS option: %s\n",rts_argv[arg]);
prog_belch("incomplete RTS option: %s",rts_argv[arg]);
error = rtsTrue;
break;
......@@ -825,7 +846,7 @@ error = rtsTrue;
/* The option prefix '-xx' is reserved for future extension. KSW 1999-11. */
default:
fprintf(stderr, "setupRtsFlags: Unknown RTS option: %s\n",rts_argv[arg]);
prog_belch("unknown RTS option: %s",rts_argv[arg]);
error = rtsTrue;
break;
}
......@@ -833,7 +854,7 @@ error = rtsTrue;
/* =========== OH DEAR ============================ */
default:
fprintf(stderr, "setupRtsFlags: Unknown RTS option: %s\n",rts_argv[arg]);
prog_belch("unknown RTS option: %s",rts_argv[arg]);
error = rtsTrue;
break;
}
......@@ -844,10 +865,9 @@ error = rtsTrue;
fflush(stdout);
for (p = usage_text; *p; p++)
fprintf(stderr, "%s\n", *p);
belch("%s", *p);
stg_exit(EXIT_FAILURE);
}
}
static FILE * /* return NULL on error */
......
/* -----------------------------------------------------------------------------
* $Id: RtsFlags.h,v 1.18 1999/11/29 12:02:45 keithw Exp $
* $Id: RtsFlags.h,v 1.19 2000/01/12 15:15:17 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -121,9 +121,6 @@ struct PROFILING_FLAGS {
struct CONCURRENT_FLAGS {
int ctxtSwitchTime; /* in milliseconds */
#ifdef SMP
nat nNodes; /* number of threads to run simultaneously */
#endif
};
#ifdef PAR
......@@ -137,9 +134,15 @@ struct PAR_FLAGS {
unsigned int packBufferSize;
unsigned int maxLocalSparks;
};
#endif /* PAR */
#ifdef SMP
struct PAR_FLAGS {
nat nNodes; /* number of threads to run simultaneously */
unsigned int maxLocalSparks;
};
#endif
#ifdef GRAN
struct GRAN_FLAGS {
rtsBool granSimStats; /* Full .gr profile (rtsTrue) or only END events? */
......@@ -243,7 +246,7 @@ struct RTS_FLAGS {
#if defined(PROFILING) || defined(DEBUG)
struct PROFILING_FLAGS ProfFlags;
#endif
#ifdef PAR
#if defined(SMP) || defined(PAR)
struct PAR_FLAGS ParFlags;
#endif
#ifdef GRAN
......
/* -----------------------------------------------------------------------------
* $Id: RtsUtils.c,v 1.10 1999/11/09 10:46:26 simonmar Exp $
* $Id: RtsUtils.c,v 1.11 2000/01/12 15:15:17 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -43,6 +43,18 @@ void barf(char *s, ...)
stg_exit(EXIT_FAILURE);
}
void prog_belch(char *s, ...)
{
va_list ap;
va_start(ap,s);
/* don't fflush(stdout); WORKAROUND bug in Linux glibc */
if (prog_argv != NULL && prog_argv[0] != NULL) {
fprintf(stderr, "%s: ", prog_argv[0]);
}
vfprintf(stderr, s, ap);
fprintf(stderr, "\n");
}
void belch(char *s, ...)
{
va_list ap;
......
/* -----------------------------------------------------------------------------
* $Id: RtsUtils.h,v 1.5 1999/11/09 10:46:25 simonmar Exp $
* $Id: RtsUtils.h,v 1.6 2000/01/12 15:15:17 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -13,6 +13,7 @@ extern void *stgReallocBytes(void *p, int n, char *msg);
extern void *stgReallocWords(void *p, int n, char *msg);
extern void barf(char *s, ...) __attribute__((__noreturn__)) ;
extern void belch(char *s, ...);
extern void prog_belch(char *s, ...);
extern void _stgAssert (char *filename, unsigned int linenum);
......
/* -----------------------------------------------------------------------------
* $Id: Schedule.c,v 1.38 1999/12/01 16:13:25 simonmar Exp $
* $Id: Schedule.c,v 1.39 2000/01/12 15:15:17 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -47,6 +47,9 @@
#include "Profiling.h"
#include "Sanity.h"
#include "Stats.h"
#include "Sparks.h"
#include <stdarg.h>
/* Main threads:
*
......@@ -98,8 +101,9 @@ static StgTSO *threadStackOverflow(StgTSO *tso);
/* flag set by signal handler to precipitate a context switch */
nat context_switch;
/* if this flag is set as well, give up execution */
static nat interrupted;
rtsBool interrupted;
/* Next thread ID to allocate.
* Locks required: sched_mutex
......@@ -145,8 +149,12 @@ task_info *task_ids;
void addToBlockedQueue ( StgTSO *tso );
static void schedule ( void );
static void initThread ( StgTSO *tso, nat stack_size );
void interruptStgRts ( void );
static StgTSO * createThread_ ( nat size, rtsBool have_lock );
#ifdef DEBUG
static void sched_belch(char *s, ...);
#endif
#ifdef SMP
pthread_mutex_t sched_mutex = PTHREAD_MUTEX_INITIALIZER;
......@@ -194,7 +202,7 @@ schedule( void )
* threads.
*/
if (interrupted) {
IF_DEBUG(scheduler,belch("schedule: interrupted"));
IF_DEBUG(scheduler, sched_belch("interrupted"));
for (t = run_queue_hd; t != END_TSO_QUEUE; t = t->link) {
deleteThread(t);
}
......@@ -215,18 +223,22 @@ schedule( void )
StgMainThread *m, **prev;
prev = &main_threads;
for (m = main_threads; m != NULL; m = m->link) {
if (m->tso->whatNext == ThreadComplete) {
switch (m->tso->whatNext) {
case ThreadComplete:
if (m->ret) {
*(m->ret) = (StgClosure *)m->tso->sp[0];
}
*prev = m->link;
m->stat = Success;
pthread_cond_broadcast(&m->wakeup);
}
if (m->tso->whatNext == ThreadKilled) {
break;
case ThreadKilled:
*prev = m->link;
m->stat = Killed;
pthread_cond_broadcast(&m->wakeup);
break;
default:
break;
}
}
}
......@@ -251,6 +263,49 @@ schedule( void )
}
#endif
/* Top up the run queue from our spark pool. We try to make the
* number of threads in the run queue equal to the number of
* free capabilities.
*/
#if defined(SMP) || defined(PAR)
{
nat n = n_free_capabilities;
StgTSO *tso = run_queue_hd;
/* Count the run queue */
while (n > 0 && tso != END_TSO_QUEUE) {