Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Tobias Decking
GHC
Commits
b933b469
Commit
b933b469
authored
Jan 12, 2000
by
simonmar
Browse files
[project @ 2000-01-12 15:15:17 by simonmar]
Add 'par' and sparking support to the SMP implementation.
parent
b034fbda
Changes
15
Hide whitespace changes
Inline
Side-by-side
ghc/includes/PrimOps.h
View file @
b933b469
/* -----------------------------------------------------------------------------
* $Id: PrimOps.h,v 1.4
2
2000/01/
07 10:27:33 sewardj
Exp $
* $Id: PrimOps.h,v 1.4
3
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
...
...
ghc/includes/Regs.h
View file @
b933b469
/* -----------------------------------------------------------------------------
* $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 */
...
...
ghc/includes/Rts.h
View file @
b933b469
/* -----------------------------------------------------------------------------
* $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
/* -----------------------------------------------------------------------------
...
...
ghc/rts/RtsFlags.c
View file @
b933b469
/* -----------------------------------------------------------------------------
* $Id: RtsFlags.c,v 1.2
1 1999/11/29 12:02:44 keithw
Exp $
* $Id: RtsFlags.c,v 1.2
2 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
.
Conc
Flags
.
nNodes
=
1
;
RtsFlags
.
Par
Flags
.
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) \
f
pr
intf(stderr, "setupRtsFlags:
GHC not built for: ticky-ticky stats
\n
"); \
pr
og_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) \
f
pr
intf(stderr, "setupRtsFlags:
GHC not built for: -prof or -parallel
\n
"); \
pr
og_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) \
f
pr
intf(stderr, "setupRtsFlags:
GHC not built for: -gransim
\n
"); \
pr
og_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,41 +653,43 @@ error = rtsTrue;
case
CCchar
:
max_cc_no
=
(
hash_t
)
decode
(
rts_argv
[
arg
]
+
3
);
if
(
max_cc_no
==
0
)
{
fprintf
(
stderr
,
"B
ad number of cost centres %s
\n
"
,
rts_argv
[
arg
]);
error
=
rtsTrue
;
prog_belch
(
"b
ad 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
,
"B
ad number of modules %s
\n
"
,
rts_argv
[
arg
]);
error
=
rtsTrue
;
prog_belch
(
"b
ad 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
,
"B
ad number of groups %s
\n
"
,
rts_argv
[
arg
]);
error
=
rtsTrue
;
prog_belch
(
"b
ad 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:
f
pr
intf
(
stderr
,
"I
nvalid index table size option: %s
\n
"
,
rts_argv
[
arg
]);
pr
og_belch
(
"i
nvalid index table size option: %s"
,
rts_argv
[
arg
]);
error
=
rtsTrue
;
}
)
break
;
...
...
@@ -684,8 +705,9 @@ 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
]);
error
=
rtsTrue
;
prog_belch
(
"invalid heap profiling selection bracketing: %s"
,
rts_argv
[
arg
]);
error
=
rtsTrue
;
}
else
{
*
right
=
'\0'
;
switch
(
rts_argv
[
arg
][
1
])
{
...
...
@@ -730,27 +752,26 @@ error = rtsTrue;
#ifdef SMP
case
'N'
:
SMP_BUILD_ONLY
(
if
(
rts_argv
[
arg
][
2
]
!=
'\0'
)
{
RtsFlags
.
Conc
Flags
.
nNodes
RtsFlags
.
Par
Flags
.
nNodes
=
strtol
(
rts_argv
[
arg
]
+
2
,
(
char
**
)
NULL
,
10
);
if
(
RtsFlags
.
Conc
Flags
.
nNodes
<=
0
)
{
fprintf
(
stderr
,
"setupRtsFlags:
bad value for -N
\n
"
);
error
=
rtsTrue
;
if
(
RtsFlags
.
Par
Flags
.
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
"
);
error
=
rtsTrue
;
prog_belch
(
"
bad value for -e"
);
error
=
rtsTrue
;
}
}
)
break
;
...
...
@@ -783,8 +804,8 @@ 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
"
);
error
=
rtsTrue
;
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'
:
f
pr
intf
(
stderr
,
"setupRtsFlags: I
ncomplete RTS option: %s
\n
"
,
rts_argv
[
arg
]);
pr
og_belch
(
"i
ncomplete 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:
f
pr
intf
(
stderr
,
"setupRtsFlags: U
nknown RTS option: %s
\n
"
,
rts_argv
[
arg
]);
pr
og_belch
(
"u
nknown RTS option: %s"
,
rts_argv
[
arg
]);
error
=
rtsTrue
;
break
;
}
...
...
@@ -833,7 +854,7 @@ error = rtsTrue;
/* =========== OH DEAR ============================ */
default:
f
pr
intf
(
stderr
,
"setupRtsFlags: U
nknown RTS option: %s
\n
"
,
rts_argv
[
arg
]);
pr
og_belch
(
"u
nknown 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 */
...
...
ghc/rts/RtsFlags.h
View file @
b933b469
/* -----------------------------------------------------------------------------
* $Id: RtsFlags.h,v 1.1
8 1999/11/29 12:02:45 keithw
Exp $
* $Id: RtsFlags.h,v 1.1
9 2000/01/12 15:15:17 simonmar
Exp $
*
* (c) The GHC Team, 1998-1999
*
...
...
@@ -120,26 +120,29 @@ struct PROFILING_FLAGS {
#endif
/* DEBUG || PROFILING */
struct
CONCURRENT_FLAGS
{
int
ctxtSwitchTime
;
/* in milliseconds */
#ifdef SMP
nat
nNodes
;
/* number of threads to run simultaneously */
#endif
int
ctxtSwitchTime
;
/* in milliseconds */
};
#ifdef PAR
struct
PAR_FLAGS
{
rtsBool
parallelStats
;
/* Gather parallel statistics */
rtsBool
granSimStats
;
/* Full .gr profile (rtsTrue) or only END events? */
rtsBool
granSimStats_Binary
;
rtsBool
outputDisabled
;
/* Disable output for performance purposes */
unsigned
int
packBufferSize
;
unsigned
int
maxLocalSparks
;
rtsBool
parallelStats
;
/* Gather parallel statistics */
rtsBool
granSimStats
;
/* Full .gr profile (rtsTrue) or only END events? */
rtsBool
granSimStats_Binary
;
rtsBool
outputDisabled
;
/* Disable output for performance purposes */
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
def
ined(SMP) || defined(
PAR
)
struct
PAR_FLAGS
ParFlags
;
#endif
#ifdef GRAN
...
...
ghc/rts/RtsUtils.c
View file @
b933b469
/* -----------------------------------------------------------------------------
* $Id: RtsUtils.c,v 1.1
0 1999/11/09 10:46:26
simonmar Exp $
* $Id: RtsUtils.c,v 1.1
1 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
;
...
...
ghc/rts/RtsUtils.h
View file @
b933b469
/* -----------------------------------------------------------------------------
* $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
);
...
...
ghc/rts/Schedule.c
View file @
b933b469
/* -----------------------------------------------------------------------------
* $Id: Schedule.c,v 1.3
8 1999/12/01
1
6
:1
3:25
simonmar Exp $
* $Id: Schedule.c,v 1.3
9 2000/01/12
1
5
:1
5: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
);
}