Commit f6692611 authored by simonmar's avatar simonmar

[project @ 1999-11-02 15:05:38 by simonmar]

This commit adds in the current state of our SMP support.  Notably,
this allows the new way 's' to be built, providing support for running
multiple Haskell threads simultaneously on top of any pthreads
implementation, the idea being to take advantage of commodity SMP
boxes.

Don't expect to get much of a speedup yet; due to the excessive
locking required to synchronise access to mutable heap objects, you'll
see a slowdown in most cases, even on a UP machine.  The best I've
seen is a 1.6-1.7 speedup on an example that did no locking (two
optimised nfibs in parallel).

	- new RTS -N flag specifies how many pthreads to start.

	- new driver -smp flag, tells the driver to use way 's'.

	- new compiler -fsmp option (not for user comsumption)
	  tells the compiler not to generate direct jumps to
	  thunk entry code.

	- largely rewritten scheduler

	- _ccall_GC is now done by handing back a "token" to the
	  RTS before executing the ccall; it should now be possible
	  to execute blocking ccalls in the current thread while
	  allowing the RTS to continue running Haskell threads as
	  normal.

	- you can only call thread-safe C libraries from a way 's'
	  build, of course.

Pthread support is still incomplete, and weird things (including
deadlocks) are likely to happen.
parent 947d2e36
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: AbsCSyn.lhs,v 1.25 1999/10/31 15:35:32 sof Exp $
% $Id: AbsCSyn.lhs,v 1.26 1999/11/02 15:05:39 simonmar Exp $
%
\section[AbstractC]{Abstract C: the last stop before machine code}
......@@ -473,6 +473,7 @@ data MagicId
node = VanillaReg PtrRep ILIT(1) -- A convenient alias for Node
tagreg = VanillaReg WordRep ILIT(2) -- A convenient alias for TagReg
nodeReg = CReg node
\end{code}
We need magical @Eq@ because @VanillaReg@s come in multiple flavors.
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CLabel.lhs,v 1.28 1999/10/13 16:39:10 simonmar Exp $
% $Id: CLabel.lhs,v 1.29 1999/11/02 15:05:40 simonmar Exp $
%
\section[CLabel]{@CLabel@: Information to make C Labels}
......@@ -37,6 +37,7 @@ module CLabel (
mkErrorStdEntryLabel,
mkUpdInfoLabel,
mkTopTickyCtrLabel,
mkBlackHoleInfoTableLabel,
mkCAFBlackHoleInfoTableLabel,
mkSECAFBlackHoleInfoTableLabel,
mkRtsPrimOpLabel,
......@@ -215,6 +216,7 @@ mkAsmTempLabel = AsmTempLabel
mkErrorStdEntryLabel = RtsLabel RtsShouldNeverHappenCode
mkUpdInfoLabel = RtsLabel RtsUpdInfo
mkTopTickyCtrLabel = RtsLabel RtsTopTickyCtr
mkBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl SLIT("BLACKHOLE_info"))
mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl SLIT("CAF_BLACKHOLE_info"))
mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then
RtsLabel (RtsBlackHoleInfoTbl SLIT("SE_CAF_BLACKHOLE_info"))
......
......@@ -787,8 +787,8 @@ pprCCall op@(CCallOp op_str is_asm may_gc cconv) args results vol_regs
where
(pp_saves, pp_restores) = ppr_vol_regs vol_regs
(pp_save_context, pp_restore_context)
| may_gc = ( text "do { SaveThreadState();"
, text "LoadThreadState();} while(0);"
| may_gc = ( text "do { I_ id; SaveThreadState(); id = suspendThread(BaseReg);"
, text "BaseReg = resumeThread(id); LoadThreadState();} while(0);"
)
| otherwise = ( pp_basic_saves $$ pp_saves,
pp_basic_restores $$ pp_restores)
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgClosure.lhs,v 1.36 1999/11/01 17:10:07 simonpj Exp $
% $Id: CgClosure.lhs,v 1.37 1999/11/02 15:05:43 simonmar Exp $
%
\section[CgClosure]{Code generation for closures}
......@@ -269,6 +269,7 @@ closureCodeBody binder_info closure_info cc [] body
cl_descr mod_name = closureDescription mod_name (closureName closure_info)
body_label = entryLabelFromCI closure_info
is_box = case body of { StgApp fun [] -> True; _ -> False }
body_code = profCtrC SLIT("TICK_ENT_THK") [] `thenC`
......@@ -577,7 +578,7 @@ thunkWrapper closure_info lbl thunk_code
thunkChecks lbl node_points (
-- Overwrite with black hole if necessary
blackHoleIt closure_info node_points `thenC`
blackHoleIt closure_info node_points `thenC`
setupUpdate closure_info ( -- setupUpdate *encloses* the rest
......@@ -624,10 +625,14 @@ blackHoleIt :: ClosureInfo -> Bool -> Code -- Only called for closures with no a
blackHoleIt closure_info node_points
= if blackHoleOnEntry closure_info && node_points
then
let
info_label = infoTableLabelFromCI closure_info
args = [ CLbl info_label DataPtrRep ]
in
absC (if closureSingleEntry(closure_info) then
CMacroStmt UPD_BH_SINGLE_ENTRY [CReg node]
CMacroStmt UPD_BH_SINGLE_ENTRY args
else
CMacroStmt UPD_BH_UPDATABLE [CReg node])
CMacroStmt UPD_BH_UPDATABLE args)
else
nopC
\end{code}
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgTailCall.lhs,v 1.22 1999/06/22 08:00:00 simonpj Exp $
% $Id: CgTailCall.lhs,v 1.23 1999/11/02 15:05:43 simonmar Exp $
%
%********************************************************
%* *
......@@ -39,7 +39,8 @@ import CgRetConv ( dataReturnConvPrim,
import CgStackery ( mkTaggedStkAmodes, adjustStackHW )
import CgUsages ( getSpRelOffset, adjustSpAndHp )
import CgUpdate ( pushSeqFrame )
import CLabel ( mkUpdInfoLabel, mkRtsPrimOpLabel )
import CLabel ( mkUpdInfoLabel, mkRtsPrimOpLabel,
mkBlackHoleInfoTableLabel )
import ClosureInfo ( nodeMustPointToIt,
getEntryConvention, EntryConvention(..),
LambdaFormInfo
......@@ -55,6 +56,7 @@ import Type ( isUnLiftedType )
import TyCon ( TyCon )
import PrimOp ( PrimOp )
import Util ( zipWithEqual )
import Unique ( mkPseudoUnique1 )
import Outputable
import Panic ( panic, assertPanic )
\end{code}
......@@ -425,6 +427,23 @@ doTailCall arg_amodes arg_regs finish_code arity pending_assts
(fast_stk_amodes, tagged_stk_amodes) =
splitAt arity stk_arg_amodes
-- eager blackholing, at the end of the basic block.
node_save = CTemp (mkPseudoUnique1 2) DataPtrRep
(r1_tmp_asst, bh_asst)
= case sequel of
#if 0
-- no: UpdateCode doesn't tell us that we're in a thunk's entry code.
-- we might be in a case continuation later down the line. Also,
-- we might have pushed a return address on the stack, if we're in
-- a case scrut, and still be in the thunk's entry code.
UpdateCode ->
(CAssign node_save nodeReg,
CAssign (CVal (CIndex node_save (mkIntCLit 0) PtrRep)
PtrRep)
(CLbl mkBlackHoleInfoTableLabel DataPtrRep))
#endif
_ -> (AbsCNop, AbsCNop)
in
-- We can omit tags on the arguments passed to the fast entry point,
-- but we have to be careful to fill in the tags on any *extra*
......@@ -442,12 +461,14 @@ doTailCall arg_amodes arg_regs finish_code arity pending_assts
-- The stack space for the pushed return addess,
-- with any args pushed on top, is recorded in final_sp.
-- Do the simultaneous assignments,
doSimAssts (mkAbstractCs [pending_assts,
-- Do the simultaneous assignments,
doSimAssts (mkAbstractCs [r1_tmp_asst,
pending_assts,
reg_arg_assts,
fast_arg_assts,
tagged_arg_assts,
tag_assts]) `thenC`
absC bh_asst `thenC`
-- push a return address if necessary
-- (after the assignments above, in case we clobber a live
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: ClosureInfo.lhs,v 1.38 1999/05/18 15:03:50 simonpj Exp $
% $Id: ClosureInfo.lhs,v 1.39 1999/11/02 15:05:44 simonmar Exp $
%
\section[ClosureInfo]{Data structures which describe closures}
......@@ -77,7 +77,8 @@ import CLabel ( CLabel, mkStdEntryLabel, mkFastEntryLabel,
mkReturnPtLabel
)
import CmdLineOpts ( opt_SccProfilingOn, opt_OmitBlackHoling,
opt_Parallel, opt_DoTickyProfiling )
opt_Parallel, opt_DoTickyProfiling,
opt_SMP )
import Id ( Id, idType, getIdArity )
import DataCon ( DataCon, dataConTag, fIRST_TAG,
isNullaryDataCon, isTupleCon, dataConName
......@@ -679,6 +680,9 @@ getEntryConvention name lf_info arg_kinds
LFThunk _ _ _ updatable std_form_info _ _
-> if updatable || opt_DoTickyProfiling -- to catch double entry
|| opt_SMP -- always enter via node on SMP, since the
-- thunk might have been blackholed in the
-- meantime.
then ViaNode
else StdEntry (thunkEntryLabel name std_form_info updatable)
......
......@@ -87,6 +87,7 @@ module CmdLineOpts (
opt_IrrefutableTuples,
opt_NumbersStrict,
opt_Parallel,
opt_SMP,
-- optimisation opts
opt_DoEtaReduction,
......@@ -375,6 +376,7 @@ opt_IrrefutableTuples = lookUp SLIT("-firrefutable-tuples")
opt_MaxContextReductionDepth = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
opt_NumbersStrict = lookUp SLIT("-fnumbers-strict")
opt_Parallel = lookUp SLIT("-fparallel")
opt_SMP = lookUp SLIT("-fsmp")
-- optimisation opts
opt_DoEtaReduction = lookUp SLIT("-fdo-eta-reduction")
......
......@@ -352,7 +352,7 @@ $BuildTag = ''; # default is sequential build w/ Appel-style GC
'_p', "-fscc-profiling -DPROFILING -optc-DPROFILING",
'_t', "-fticky-ticky -DTICKY_TICKY -optc-DTICKY_TICKY",
'_u', "-optc-DNO_REGS -optc-DUSE_MINIINTERPRETER -fno-asm-mangling -funregisterised",
'_s', "-fparallel -optc-pthread -optl-pthread -optc-DSMP",
'_s', "-fsmp -optc-pthread -optl-pthread -optc-DSMP",
'_mp', "-fparallel -D__PARALLEL_HASKELL__ -optc-DPAR",
'_mg', "-fgransim -D__GRANSIM__ -optc-DGRAN");
......@@ -3054,6 +3054,7 @@ arg: while($_ = $Args[0]) {
/^-fticky-ticky$/ && do { push(@HsC_flags,$_); next arg; };
/^-fgransim$/ && do { push(@HsC_flags,$_); next arg; };
/^-fparallel$/ && do { push(@HsC_flags,$_); next arg; };
/^-fsmp$/ && do { push(@HsC_flags,$_); next arg; };
/^-split-objs$/ && do {
if ( $TargetPlatform !~ /^(alpha|hppa1\.1|i386|m68k|mips|powerpc|rs6000|sparc)-/ ) {
......
/* -----------------------------------------------------------------------------
* $Id: MachRegs.h,v 1.5 1999/06/25 09:13:38 simonmar Exp $
* $Id: MachRegs.h,v 1.6 1999/11/02 15:05:50 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -206,6 +206,7 @@
#define REG_Base ebx
#endif
#define REG_Sp ebp
/* #define REG_Su ebx*/
#if STOLEN_X86_REGS >= 3
# define REG_R1 esi
......
/* -----------------------------------------------------------------------------
* $Id: PrimOps.h,v 1.37 1999/08/25 16:11:43 simonmar Exp $
* $Id: PrimOps.h,v 1.38 1999/11/02 15:05:51 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -710,6 +710,12 @@ EF_(forkzh_fast);
EF_(yieldzh_fast);
EF_(killThreadzh_fast);
EF_(seqzh_fast);
EF_(unblockExceptionszh_fast);
#define blockExceptionszh_fast \
if (CurrentTSO->pending_exceptions == NULL) { \
CurrentTSO->pending_exceptions = &END_EXCEPTION_LIST_closure; \
}
#define myThreadIdzh(t) (t = CurrentTSO)
......
/* -----------------------------------------------------------------------------
* $Id: Regs.h,v 1.4 1999/03/02 19:44:14 sof Exp $
* $Id: Regs.h,v 1.5 1999/11/02 15:05:51 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -25,7 +25,7 @@
* 2) caller-saves registers are saved across a CCall
*/
typedef struct {
typedef struct StgRegTable_ {
StgUnion rR1;
StgUnion rR2;
StgUnion rR3;
......@@ -48,9 +48,22 @@ typedef struct {
StgPtr rSpLim;
StgPtr rHp;
StgPtr rHpLim;
StgTSO *rCurrentTSO;
bdescr *rNursery;
bdescr *rCurrentNursery;
#ifdef SMP
struct StgRegTable_ *link;
#endif
} StgRegTable;
/* No such thing as a MainRegTable under SMP - each thread must
* have its own MainRegTable.
*/
#ifndef SMP
extern DLL_IMPORT_RTS StgRegTable MainRegTable;
#endif
#ifdef IN_STG_CODE
/*
* Registers Hp and HpLim are global across the entire system, and are
......@@ -85,32 +98,35 @@ extern DLL_IMPORT_RTS StgRegTable MainRegTable;
#define SAVE_Su (CurrentTSO->su)
#define SAVE_SpLim (CurrentTSO->splim)
#define SAVE_Hp (MainRegTable.rHp)
#define SAVE_HpLim (MainRegTable.rHpLim)
#define SAVE_Hp (BaseReg->rHp)
#define SAVE_HpLim (BaseReg->rHpLim)
#define SAVE_CurrentTSO (BaseReg->rCurrentTSO)
#define SAVE_CurrentNursery (BaseReg->rCurrentNursery)
/* We sometimes need to save registers across a C-call, eg. if they
* are clobbered in the standard calling convention. We define the
* save locations for all registers in the register table.
*/
#define SAVE_R1 (MainRegTable.rR1)
#define SAVE_R2 (MainRegTable.rR2)
#define SAVE_R3 (MainRegTable.rR3)
#define SAVE_R4 (MainRegTable.rR4)
#define SAVE_R5 (MainRegTable.rR5)
#define SAVE_R6 (MainRegTable.rR6)
#define SAVE_R7 (MainRegTable.rR7)
#define SAVE_R8 (MainRegTable.rR8)
#define SAVE_R1 (BaseReg->rR1)
#define SAVE_R2 (BaseReg->rR2)
#define SAVE_R3 (BaseReg->rR3)
#define SAVE_R4 (BaseReg->rR4)
#define SAVE_R5 (BaseReg->rR5)
#define SAVE_R6 (BaseReg->rR6)
#define SAVE_R7 (BaseReg->rR7)
#define SAVE_R8 (BaseReg->rR8)
#define SAVE_F1 (MainRegTable.rF1)
#define SAVE_F2 (MainRegTable.rF2)
#define SAVE_F3 (MainRegTable.rF3)
#define SAVE_F4 (MainRegTable.rF4)
#define SAVE_F1 (BaseReg->rF1)
#define SAVE_F2 (BaseReg->rF2)
#define SAVE_F3 (BaseReg->rF3)
#define SAVE_F4 (BaseReg->rF4)
#define SAVE_D1 (MainRegTable.rD1)
#define SAVE_D2 (MainRegTable.rD2)
#define SAVE_D1 (BaseReg->rD1)
#define SAVE_D2 (BaseReg->rD2)
#define SAVE_L1 (MainRegTable.rL1)
#define SAVE_L1 (BaseReg->rL1)
/* -----------------------------------------------------------------------------
* Emit the GCC-specific register declarations for each machine
......@@ -240,6 +256,9 @@ GLOBAL_REG_DECL(StgWord64,L1,REG_L1)
#ifdef REG_Base
GLOBAL_REG_DECL(StgRegTable *,BaseReg,REG_Base)
#else
#ifdef SMP
#error BaseReg must be in a register for SMP
#endif
#define BaseReg (&MainRegTable)
#endif
......@@ -273,6 +292,18 @@ GLOBAL_REG_DECL(P_,HpLim,REG_HpLim)
#define HpLim (BaseReg->rHpLim)
#endif
#ifdef REG_CurrentTSO
GLOBAL_REG_DECL(StgTSO *,CurrentTSO,REG_CurrentTSO)
#else
#define CurrentTSO (BaseReg->rCurrentTSO)
#endif
#ifdef REG_CurrentNursery
GLOBAL_REG_DECL(bdescr *,CurrentNursery,REG_CurrentNursery)
#else
#define CurrentNursery (BaseReg->rCurrentNursery)
#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
......@@ -456,6 +487,9 @@ GLOBAL_REG_DECL(P_,HpLim,REG_HpLim)
#endif
#ifdef CALLER_SAVES_Base
#ifdef SMP
#error "Can't have caller-saved BaseReg with SMP"
#endif
#define CALLER_SAVE_Base /* nothing */
#define CALLER_RESTORE_Base BaseReg = &MainRegTable;
#else
......@@ -463,10 +497,30 @@ GLOBAL_REG_DECL(P_,HpLim,REG_HpLim)
#define CALLER_RESTORE_Base /* nothing */
#endif
#ifdef CALLER_SAVES_CurrentTSO
#define CALLER_SAVE_CurrentTSO SAVE_CurrentTSO = CurrentTSO;
#define CALLER_RESTORE_CurrentTSO CurrentTSO = SAVE_CurrentTSO;
#else
#define CALLER_SAVE_CurrentTSO /* nothing */
#define CALLER_RESTORE_CurrentTSO /* nothing */
#endif
#ifdef CALLER_SAVES_CurrentNursery
#define CALLER_SAVE_CurrentNursery SAVE_CurrentNursery = CurrentNursery;
#define CALLER_RESTORE_CurrentNursery CurrentNursery = SAVE_CurrentNursery;
#else
#define CALLER_SAVE_CurrentNursery /* nothing */
#define CALLER_RESTORE_CurrentNursery /* nothing */
#endif
#endif /* IN_STG_CODE */
/* ----------------------------------------------------------------------------
Handy bunches of saves/restores
------------------------------------------------------------------------ */
#ifdef IN_STG_CODE
#define CALLER_SAVE_USER \
CALLER_SAVE_R1 \
CALLER_SAVE_R2 \
......@@ -489,7 +543,9 @@ GLOBAL_REG_DECL(P_,HpLim,REG_HpLim)
CALLER_SAVE_Su \
CALLER_SAVE_SpLim \
CALLER_SAVE_Hp \
CALLER_SAVE_HpLim
CALLER_SAVE_HpLim \
CALLER_SAVE_CurrentTSO \
CALLER_SAVE_CurrentNursery
#define CALLER_RESTORE_USER \
CALLER_RESTORE_R1 \
......@@ -514,7 +570,18 @@ GLOBAL_REG_DECL(P_,HpLim,REG_HpLim)
CALLER_RESTORE_Su \
CALLER_RESTORE_SpLim \
CALLER_RESTORE_Hp \
CALLER_RESTORE_HpLim
CALLER_RESTORE_HpLim \
CALLER_RESTORE_CurrentTSO \
CALLER_RESTORE_CurrentNursery
#else /* not IN_STG_CODE */
#define CALLER_SAVE_USER /* nothing */
#define CALLER_SAVE_SYSTEM /* nothing */
#define CALLER_RESTORE_USER /* nothing */
#define CALLER_RESTORE_SYSTEM /* nothing */
#endif /* IN_STG_CODE */
#define CALLER_SAVE_ALL \
CALLER_SAVE_SYSTEM \
......
/* -----------------------------------------------------------------------------
* $Id: Rts.h,v 1.7 1999/08/25 16:11:44 simonmar Exp $
* $Id: Rts.h,v 1.8 1999/11/02 15:05:52 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -10,8 +10,8 @@
#ifndef RTS_H
#define RTS_H
#ifndef NO_REGS
#define NO_REGS /* don't define fixed registers */
#ifndef IN_STG_CODE
#define NOT_IN_STG_CODE
#endif
#include "Stg.h"
......
/* ----------------------------------------------------------------------------
* $Id: RtsAPI.h,v 1.7 1999/07/06 09:42:39 sof Exp $
* $Id: RtsAPI.h,v 1.8 1999/11/02 15:05:52 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -14,6 +14,7 @@
* Running the scheduler
*/
typedef enum {
NoStatus, /* not finished yet */
Success,
Killed, /* another thread killed us */
Interrupted, /* stopped in response to a call to interruptStgRts */
......
/* ----------------------------------------------------------------------------
* $Id: SMP.h,v 1.1 1999/11/02 15:05:52 simonmar Exp $
*
* (c) The GHC Team, 1999
*
* Macros for SMP support
*
* -------------------------------------------------------------------------- */
#ifndef SMP_H
#define SMP_H
/* SMP is currently not compatible with the following options:
*
* INTERPRETER
* PROFILING
* TICKY_TICKY
* and unregisterised builds.
*/
#if defined(SMP)
#if defined(INTERPRETER) \
|| defined(PROFILING) \
|| defined(TICKY_TICKY)
#error Build options incompatible with SMP.
#endif
/*
* CMPXCHG - this instruction is the standard "test & set". We use it
* for locking closures in the thunk and blackhole entry code. If the
* closure is already locked, or has an unexpected info pointer
* (because another thread is altering it in parallel), we just jump
* to the new entry point.
*/
#if defined(i386_TARGET_ARCH) && defined(TABLES_NEXT_TO_CODE)
#define CMPXCHG(p, cmp, new) \
__asm__ __volatile__ ( \
"lock ; cmpxchg %1, %0\n" \
"\tje 1f\n" \
"\tjmp *%%eax\n" \
"\t1:\n" \
: /* no outputs */ \
: "m" (p), "r" (new), "r" (cmp) \
)
/*
* XCHG - the atomic exchange instruction. Used for locking closures
* during updates (see LOCK_CLOSURE below) and the MVar primops.
*/
#define XCHG(reg, obj) \
__asm__ __volatile__ ( \
"xchgl %1,%0" \
:"+r" (reg), "+m" (obj) \
: /* no input-only operands */ \
)
#else
#error SMP macros not defined for this architecture
#endif
/*
* LOCK_CLOSURE locks the specified closure, busy waiting for any
* existing locks to be cleared.
*/
#define LOCK_CLOSURE(c) \
({ \
const StgInfoTable *__info; \
__info = &WHITEHOLE_info; \
do { \
XCHG(__info,((StgClosure *)(c))->header.info); \
} while (__info == &WHITEHOLE_info); \
__info; \
})
#define LOCK_THUNK(__info) \
CMPXCHG(R1.cl->header.info, __info, &WHITEHOLE_info);
#define ACQUIRE_LOCK(mutex) pthread_mutex_lock(mutex);
#define RELEASE_LOCK(mutex) pthread_mutex_unlock(mutex);
#else /* !SMP */
#define LOCK_CLOSURE(c) /* nothing */
#define LOCK_THUNK(__info) /* nothing */
#define ACQUIRE_LOCK(mutex) /* nothing */
#define RELEASE_LOCK(mutex) /* nothing */
#endif /* SMP */
#endif /* SMP_H */
/* -----------------------------------------------------------------------------
* $Id: SchedAPI.h,v 1.6 1999/07/06 09:42:39 sof Exp $
* $Id: SchedAPI.h,v 1.7 1999/11/02 15:05:52 simonmar Exp $
*
* (c) The GHC Team 1998
*
......@@ -17,13 +17,14 @@
* not compiling rts/ bits. -- sof 7/99
*
*/
SchedulerStatus schedule(StgTSO *main_thread, /*out*/StgClosure **ret);
SchedulerStatus waitThread(StgTSO *main_thread, /*out*/StgClosure **ret);
/*
* Creating threads
*/
StgTSO *createThread (nat stack_size);
StgTSO *createThread(nat stack_size);
void scheduleThread(StgTSO *tso);
static inline void pushClosure (StgTSO *tso, StgClosure *c) {
tso->sp--;
......
/* -----------------------------------------------------------------------------
* $Id: Stg.h,v 1.17 1999/07/06 09:42:39 sof Exp $
* $Id: Stg.h,v 1.18 1999/11/02 15:05:52 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -16,6 +16,17 @@
#define _POSIX_SOURCE
#endif
/* If we include "Stg.h" directly, we're in STG code, and we therefore
* get all the global register variables, macros etc. that go along
* with that. If "Stg.h" is included via "Rts.h", we're assumed to
* be in vanilla C.
*/
#ifdef NOT_IN_STG_CODE
#define NO_REGS /* don't define fixed registers */
#else
#define IN_STG_CODE
#endif
/* Configuration */
#include "config.h"
#ifdef __HUGS__ /* vile hack till the GHC folks come on board */
......@@ -33,13 +44,17 @@
* For now, do lazy and not eager.
*/
#define LAZY_BLACKHOLING
/* #define EAGER_BLACKHOLING */
#ifdef TICKY_TICKY
/* TICKY_TICKY needs EAGER_BLACKHOLING to verify no double-entries of single-entry thunks. */
# undef LAZY_BLACKHOLING
# define EAGER_BLACKHOLING
/* TICKY_TICKY needs EAGER_BLACKHOLING to verify no double-entries of
* single-entry thunks.
*
* SMP needs EAGER_BLACKHOLING because it has to lock thunks
* synchronously, in case another thread is trying to evaluate the
* same thunk simultaneously.
*/
#if defined(SMP) || defined(TICKY_TICKY)
# define EAGER_BLACKHOLING
#else
# define LAZY_BLACKHOLING
#endif
/* ToDo: Set this flag properly: COMPILER and INTERPRETER should not be mutually exclusive. */
......@@ -96,8 +111,10 @@ 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"
......@@ -121,6 +138,10 @@ void _stgAssert (char *, unsigned int);
#include <unistd.h>
#endif
#ifdef SMP
#include <pthread.h>
#endif
/* GNU mp library */
#include "gmp.h"
......
/* -----------------------------------------------------------------------------
* $Id: StgMacros.h,v 1.13 1999/10/13 16:39:21 simonmar Exp $
* $Id: StgMacros.h,v 1.14 1999/11/02 15:05:52 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -416,12 +416,23 @@ EDI_(stg_gen_chk_info);
#define SET_TAG(t) /* nothing */
#ifdef EAGER_BLACKHOLING
# define UPD_BH_UPDATABLE(thunk) \
TICK_UPD_BH_UPDATABLE(); \
SET_INFO((StgClosure *)thunk,&BLACKHOLE_info)
# define UPD_BH_SINGLE_ENTRY(thunk) \
TICK_UPD_BH_SINGLE_ENTRY(); \
SET_INFO((StgClosure *)thunk,&SE_BLACKHOLE_info)
# ifdef SMP
# define UPD_BH_UPDATABLE(info) \
TICK_UPD_BH_UPDATABLE(); \
LOCK_THUNK(info); \
SET_INFO(R1.cl,&BLACKHOLE_info)
# define UPD_BH_SINGLE_ENTRY(info) \
TICK_UPD_BH_SINGLE_ENTRY(); \
LOCK_THUNK(info); \
SET_INFO(R1.cl,&BLACKHOLE_info)
# else
# define UPD_BH_UPDATABLE(info) \
TICK_UPD_BH_UPDATABLE(); \
SET_INFO(R1.cl,&BLACKHOLE_info)
# define UPD_BH_SINGLE_ENTRY(info) \
TICK_UPD_BH_SINGLE_ENTRY(); \
SET_INFO(R1.cl,&SE_BLACKHOLE_info)
# endif
#else /* !EAGER_BLACKHOLING */
# define UPD_BH_UPDATABLE(thunk) /* nothing */
# define UPD_BH_SINGLE_ENTRY(thunk) /* nothing */
......@@ -642,10 +653,15 @@ extern DLL_IMPORT_DATA const StgPolyInfoTable seq_frame_info;
We save all the STG registers (that is, the ones that are mapped to
machine registers) in their places in the TSO.
The stack registers go into the current stack object, and the heap
registers are saved in global locations.
The stack registers go into the current stack object, and the
current nursery is updated from the heap pointer.
These functions assume that BaseReg is loaded appropriately (if
we have one).
-------------------------------------------------------------------------- */
#ifndef NO_REGS
static __inline__ void
SaveThreadState(void)
{
......@@ -656,6 +672,12 @@ SaveThreadState(void)
CurrentTSO->splim = SpLim;
CloseNursery(Hp);
#ifdef REG_CurrentTSO
SAVE_CurrentTSO = CurrentTSO;
#endif
#ifdef REG_CurrentNursery
SAVE_CurrentNursery = CurrentNursery;
#endif
#if defined(PROFILING)
CurrentTSO->prof.CCCS = CCCS;
#endif
......@@ -664,19 +686,30 @@ SaveThreadState(void)
static __inline__ void
LoadThreadState (void)
{
#ifdef REG_Base
BaseReg = (StgRegTable*)&MainRegTable;
#endif
Sp = CurrentTSO->sp;
Su = CurrentTSO->su;
SpLim = CurrentTSO->splim;
OpenNursery(Hp,HpLim);
#ifdef REG_CurrentTSO
CurrentTSO = SAVE_CurrentTSO;
#endif
#ifdef REG_CurrentNursery
CurrentNursery = SAVE_CurrentNursery;
#endif
# if defined(PROFILING)
CCCS = CurrentTSO->prof.CCCS;