Commit 03a9ff01 authored by simonmar's avatar simonmar

[project @ 2005-10-21 14:02:17 by simonmar]

Big re-hash of the threaded/SMP runtime

This is a significant reworking of the threaded and SMP parts of
the runtime.  There are two overall goals here:

  - To push down the scheduler lock, reducing contention and allowing
    more parts of the system to run without locks.  In particular,
    the scheduler does not require a lock any more in the common case.

  - To improve affinity, so that running Haskell threads stick to the
    same OS threads as much as possible.

At this point we have the basic structure working, but there are some
pieces missing.  I believe it's reasonably stable - the important
parts of the testsuite pass in all the (normal,threaded,SMP) ways.

In more detail:

  - Each capability now has a run queue, instead of one global run
    queue.  The Capability and Task APIs have been completely
    rewritten; see Capability.h and Task.h for the details.

  - Each capability has its own pool of worker Tasks.  Hence, Haskell
    threads on a Capability's run queue will run on the same worker
    Task(s).  As long as the OS is doing something reasonable, this
    should mean they usually stick to the same CPU.  Another way to
    look at this is that we're assuming each Capability is associated
    with a fixed CPU.

  - What used to be StgMainThread is now part of the Task structure.
    Every OS thread in the runtime has an associated Task, and it
    can ask for its current Task at any time with myTask().

  - removed RTS_SUPPORTS_THREADS symbol, use THREADED_RTS instead
    (it is now defined for SMP too).

  - The RtsAPI has had to change; we must explicitly pass a Capability
    around now.  The previous interface assumed some global state.
    SchedAPI has also changed a lot.

  - The OSThreads API now supports thread-local storage, used to
    implement myTask(), although it could be done more efficiently
    using gcc's __thread extension when available.

  - I've moved some POSIX-specific stuff into the posix subdirectory,
    moving in the direction of separating out platform-specific
    implementations.

  - lots of lock-debugging and assertions in the runtime.  In particular,
    when DEBUG is on, we catch multiple ACQUIRE_LOCK()s, and there is
    also an ASSERT_LOCK_HELD() call.

What's missing so far:

  - I have almost certainly broken the Win32 build, will fix soon.

  - any kind of thread migration or load balancing.  This is high up
    the agenda, though.

  - various performance tweaks to do

  - throwTo and forkProcess still do not work in SMP mode
parent 63e8af08
......@@ -503,13 +503,15 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
Nothing -> text "(StgClosure*)deRefStablePtr(the_stableptr)"
Just hs_fn -> char '&' <> ppr hs_fn <> text "_closure"
cap = text "cap" <> comma
-- the expression we give to rts_evalIO
expr_to_run
= foldl appArg the_cfun arg_info -- NOT aug_arg_info
where
appArg acc (arg_cname, _, arg_hty, _)
= text "rts_apply"
<> parens (acc <> comma <> mkHObj arg_hty <> parens arg_cname)
<> parens (cap <> acc <> comma <> mkHObj arg_hty <> parens (cap <> arg_cname))
-- various other bits for inside the fn
declareResult = text "HaskellObj ret;"
......@@ -556,13 +558,15 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
fun_proto $$
vcat
[ lbrace
, text "SchedulerStatus rc;"
, text "Capability *cap;"
, declareResult
, declareCResult
, text "rts_lock();"
, text "cap = rts_lock();"
-- create the application + perform it.
, text "rc=rts_evalIO" <> parens (
, text "cap=rts_evalIO" <> parens (
cap <>
text "rts_apply" <> parens (
cap <>
text "(HaskellObj)"
<> text (if is_IO_res_ty
then "runIO_closure"
......@@ -573,9 +577,9 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
<> text "&ret"
) <> semi
, text "rts_checkSchedStatus" <> parens (doubleQuotes (ftext c_nm)
<> comma <> text "rc") <> semi
<> comma <> text "cap") <> semi
, assignCResult
, text "rts_unlock();"
, text "rts_unlock(cap);"
, if res_hty_is_unit then empty
else text "return cret;"
, rbrace
......
......@@ -165,13 +165,21 @@ extern void initBlockAllocator(void);
/* Allocation -------------------------------------------------------------- */
extern bdescr *allocGroup(nat n);
extern bdescr *allocBlock(void);
bdescr *allocGroup(nat n);
bdescr *allocBlock(void);
// versions that take the storage manager lock for you:
bdescr *allocGroup_lock(nat n);
bdescr *allocBlock_lock(void);
/* De-Allocation ----------------------------------------------------------- */
extern void freeGroup(bdescr *p);
extern void freeChain(bdescr *p);
void freeGroup(bdescr *p);
void freeChain(bdescr *p);
// versions that take the storage manager lock for you:
void freeGroup_lock(bdescr *p);
void freeChain_lock(bdescr *p);
/* Round a value to megablocks --------------------------------------------- */
......
......@@ -292,6 +292,8 @@
#error mp_limb_t != StgWord: assumptions in PrimOps.cmm are now false
#endif
#define MyCapability() (BaseReg - OFFSET_Capability_r)
/* -------------------------------------------------------------------------
Allocation and garbage collection
------------------------------------------------------------------------- */
......
......@@ -231,7 +231,7 @@
#define BlockedOnGA 9
/* same as above but without sending a Fetch message */
#define BlockedOnGA_NoSend 10
/* Only relevant for RTS_SUPPORTS_THREADS: */
/* Only relevant for THREADED_RTS: */
#define BlockedOnCCall 11
#define BlockedOnCCall_NoUnblockExc 12
/* same as above but don't unblock async exceptions in resumeThread() */
......
......@@ -15,6 +15,8 @@ ifeq "$(GhcUnregisterised)" "YES"
SRC_CC_OPTS += -DNO_REGS -DUSE_MINIINTERPRETER
endif
SRC_CC_OPTS += -I. -I../rts
#
# Header file built from the configure script's findings
#
......@@ -140,7 +142,7 @@ mkGHCConstants : mkGHCConstants.o
$(CC) -o $@ $(CC_OPTS) $(LD_OPTS) mkGHCConstants.o
mkGHCConstants.o : mkDerivedConstants.c
$(CC) -o $@ -c $< -DGEN_HASKELL
$(CC) -o $@ $(CC_OPTS) -c $< -DGEN_HASKELL
GHCConstants.h : mkGHCConstants
./mkGHCConstants >$@
......
......@@ -10,27 +10,63 @@
#ifndef __OSTHREADS_H__
#define __OSTHREADS_H__
#if defined(RTS_SUPPORTS_THREADS) /* to the end */
#if defined(THREADED_RTS) /* to the end */
# if defined(HAVE_PTHREAD_H) && !defined(WANT_NATIVE_WIN32_THREADS)
# include <pthread.h>
#include <pthread.h>
typedef pthread_cond_t Condition;
typedef pthread_mutex_t Mutex;
typedef pthread_t OSThreadId;
typedef pthread_key_t ThreadLocalKey;
#define OSThreadProcAttr /* nothing */
#define INIT_MUTEX_VAR PTHREAD_MUTEX_INITIALIZER
#define INIT_COND_VAR PTHREAD_COND_INITIALIZER
#ifdef LOCK_DEBUG
#define ACQUIRE_LOCK(mutex) \
debugBelch("ACQUIRE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); \
pthread_mutex_lock(mutex)
#define RELEASE_LOCK(mutex) \
debugBelch("RELEASE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); \
pthread_mutex_unlock(mutex)
#define ASSERT_LOCK_HELD(mutex) /* nothing */
#elif defined(DEBUG) && defined(linux_HOST_OS)
#include <errno.h>
/*
* On Linux, we can use extensions to determine whether we already
* hold a lock or not, which is useful for debugging.
*/
#define ACQUIRE_LOCK(mutex) \
if (pthread_mutex_lock(mutex) == EDEADLK) { \
barf("multiple ACQUIRE_LOCK: %s %d", __FILE__,__LINE__); \
}
#define RELEASE_LOCK(mutex) \
if (pthread_mutex_unlock(mutex) != 0) { \
barf("RELEASE_LOCK: I do not own this lock: %s %d", __FILE__,__LINE__); \
}
#define ASSERT_LOCK_HELD(mutex) ASSERT(pthread_mutex_lock(mutex) == EDEADLK)
#define ASSERT_LOCK_NOTHELD(mutex) \
if (pthread_mutex_lock(mutex) != EDEADLK) { \
pthread_mutex_unlock(mutex); \
} else { \
ASSERT(0); \
}
#else
#define ACQUIRE_LOCK(mutex) pthread_mutex_lock(mutex)
#define RELEASE_LOCK(mutex) pthread_mutex_unlock(mutex)
#define ASSERT_LOCK_HELD(mutex) /* nothing */
#endif
# elif defined(HAVE_WINDOWS_H)
......@@ -39,6 +75,9 @@ typedef pthread_t OSThreadId;
typedef HANDLE Condition;
typedef HANDLE Mutex;
typedef DWORD OSThreadId;
typedef DWORD ThreadLocalKey;
#define OSThreadProcAttr __stdcall
#define INIT_MUTEX_VAR 0
#define INIT_COND_VAR 0
......@@ -59,10 +98,27 @@ RELEASE_LOCK(Mutex *mutex)
}
}
#define ASSERT_LOCK_HELD(mutex) /* nothing */
# else
# error "Threads not supported"
# endif
//
// General thread operations
//
extern OSThreadId osThreadId ( void );
extern void shutdownThread ( void );
extern void yieldThread ( void );
typedef void OSThreadProcAttr OSThreadProc(void *);
extern int createOSThread ( OSThreadId* tid,
OSThreadProc *startProc, void *param);
//
// Condition Variables
//
extern void initCondition ( Condition* pCond );
extern void closeCondition ( Condition* pCond );
extern rtsBool broadcastCondition ( Condition* pCond );
......@@ -70,17 +126,23 @@ extern rtsBool signalCondition ( Condition* pCond );
extern rtsBool waitCondition ( Condition* pCond,
Mutex* pMut );
//
// Mutexes
//
extern void initMutex ( Mutex* pMut );
extern OSThreadId osThreadId ( void );
extern void shutdownThread ( void );
extern void yieldThread ( void );
extern int createOSThread ( OSThreadId* tid,
void (*startProc)(void) );
//
// Thread-local storage
//
void newThreadLocalKey (ThreadLocalKey *key);
void *getThreadLocalVar (ThreadLocalKey *key);
void setThreadLocalVar (ThreadLocalKey *key, void *value);
#else
#define ACQUIRE_LOCK(l)
#define RELEASE_LOCK(l)
#define ASSERT_LOCK_HELD(l)
#endif /* defined(RTS_SUPPORTS_THREADS) */
......
......@@ -99,38 +99,12 @@ typedef struct StgRegTable_ {
MP_INT rmp_result1;
MP_INT rmp_result2;
#if defined(SMP) || defined(PAR)
StgSparkPool rSparks; /* per-task spark pool */
StgSparkPool rSparks; /* per-task spark pool */
#endif
StgWord rInHaskell; /* non-zero if we're in Haskell code */
// If this flag is set, we are running Haskell code. Used to detect
// uses of 'foreign import unsafe' that should be 'safe'.
} StgRegTable;
/* A capability is a combination of a FunTable and a RegTable. In STG
* code, BaseReg normally points to the RegTable portion of this
* structure, so that we can index both forwards and backwards to take
* advantage of shorter instruction forms on some archs (eg. x86).
*/
typedef struct Capability_ {
StgFunTable f;
StgRegTable r;
#if defined(SMP)
struct Capability_ *link; /* per-task register tables are linked together */
#endif
} Capability;
/* No such thing as a MainCapability under SMP - each thread must have
* its own Capability.
*/
#ifndef SMP
#if IN_STG_CODE
extern W_ MainCapability[];
#else
extern DLL_IMPORT_RTS Capability MainCapability;
#endif
#endif
#if IN_STG_CODE
/*
......@@ -329,13 +303,32 @@ GLOBAL_REG_DECL(StgWord64,L1,REG_L1)
* concurrent Haskell, MainRegTable otherwise).
*/
/* A capability is a combination of a FunTable and a RegTable. In STG
* code, BaseReg normally points to the RegTable portion of this
* structure, so that we can index both forwards and backwards to take
* advantage of shorter instruction forms on some archs (eg. x86).
* This is a cut-down version of the Capability structure; the full
* version is defined in Capability.h.
*/
struct PartCapability_ {
StgFunTable f;
StgRegTable r;
};
/* No such thing as a MainCapability under SMP - each thread must have
* its own Capability.
*/
#if IN_STG_CODE && !defined(SMP)
extern W_ MainCapability[];
#endif
#if defined(REG_Base) && !defined(NO_GLOBAL_REG_DECLS)
GLOBAL_REG_DECL(StgRegTable *,BaseReg,REG_Base)
#else
#ifdef SMP
#error BaseReg must be in a register for SMP
#endif
#define BaseReg (&((Capability *)MainCapability)[0].r)
#define BaseReg (&((struct Capability_)MainCapability).r)
#endif
#if defined(REG_Sp) && !defined(NO_GLOBAL_REG_DECLS)
......
......@@ -104,6 +104,8 @@ extern void _assertFail (char *, unsigned int);
/* Parallel information */
#include "Parallel.h"
#include "OSThreads.h"
#include "SMP.h"
/* STG/Optimised-C related stuff */
#include "Block.h"
......
......@@ -27,6 +27,12 @@ typedef enum {
typedef StgClosure *HaskellObj;
/*
* An abstract type representing the token returned by rts_lock() and
* used when allocating objects and threads in the RTS.
*/
typedef struct Capability_ Capability;
/* ----------------------------------------------------------------------------
Starting up and shutting down the Haskell RTS.
------------------------------------------------------------------------- */
......@@ -41,39 +47,39 @@ extern void setProgArgv ( int argc, char *argv[] );
/* ----------------------------------------------------------------------------
Locking.
In a multithreaded environments, you have to surround all access to the
RtsAPI with these calls.
You have to surround all access to the RtsAPI with these calls.
------------------------------------------------------------------------- */
void
rts_lock ( void );
// acquires a token which may be used to create new objects and
// evaluate them.
Capability *rts_lock (void);
void
rts_unlock ( void );
// releases the token acquired with rts_lock().
void rts_unlock (Capability *token);
/* ----------------------------------------------------------------------------
Building Haskell objects from C datatypes.
------------------------------------------------------------------------- */
HaskellObj rts_mkChar ( HsChar c );
HaskellObj rts_mkInt ( HsInt i );
HaskellObj rts_mkInt8 ( HsInt8 i );
HaskellObj rts_mkInt16 ( HsInt16 i );
HaskellObj rts_mkInt32 ( HsInt32 i );
HaskellObj rts_mkInt64 ( HsInt64 i );
HaskellObj rts_mkWord ( HsWord w );
HaskellObj rts_mkWord8 ( HsWord8 w );
HaskellObj rts_mkWord16 ( HsWord16 w );
HaskellObj rts_mkWord32 ( HsWord32 w );
HaskellObj rts_mkWord64 ( HsWord64 w );
HaskellObj rts_mkPtr ( HsPtr a );
HaskellObj rts_mkFunPtr ( HsFunPtr a );
HaskellObj rts_mkFloat ( HsFloat f );
HaskellObj rts_mkDouble ( HsDouble f );
HaskellObj rts_mkStablePtr ( HsStablePtr s );
HaskellObj rts_mkBool ( HsBool b );
HaskellObj rts_mkString ( char *s );
HaskellObj rts_apply ( HaskellObj, HaskellObj );
HaskellObj rts_mkChar ( Capability *, HsChar c );
HaskellObj rts_mkInt ( Capability *, HsInt i );
HaskellObj rts_mkInt8 ( Capability *, HsInt8 i );
HaskellObj rts_mkInt16 ( Capability *, HsInt16 i );
HaskellObj rts_mkInt32 ( Capability *, HsInt32 i );
HaskellObj rts_mkInt64 ( Capability *, HsInt64 i );
HaskellObj rts_mkWord ( Capability *, HsWord w );
HaskellObj rts_mkWord8 ( Capability *, HsWord8 w );
HaskellObj rts_mkWord16 ( Capability *, HsWord16 w );
HaskellObj rts_mkWord32 ( Capability *, HsWord32 w );
HaskellObj rts_mkWord64 ( Capability *, HsWord64 w );
HaskellObj rts_mkPtr ( Capability *, HsPtr a );
HaskellObj rts_mkFunPtr ( Capability *, HsFunPtr a );
HaskellObj rts_mkFloat ( Capability *, HsFloat f );
HaskellObj rts_mkDouble ( Capability *, HsDouble f );
HaskellObj rts_mkStablePtr ( Capability *, HsStablePtr s );
HaskellObj rts_mkBool ( Capability *, HsBool b );
HaskellObj rts_mkString ( Capability *, char *s );
HaskellObj rts_apply ( Capability *, HaskellObj, HaskellObj );
/* ----------------------------------------------------------------------------
Deconstructing Haskell objects
......@@ -103,26 +109,31 @@ HsBool rts_getBool ( HaskellObj );
Note that these calls may cause Garbage Collection, so all HaskellObj
references are rendered invalid by these calls.
------------------------------------------------------------------------- */
SchedulerStatus
rts_eval ( HaskellObj p, /*out*/HaskellObj *ret );
Capability *
rts_eval (Capability *, HaskellObj p, /*out*/HaskellObj *ret);
SchedulerStatus
rts_eval_ ( HaskellObj p, unsigned int stack_size, /*out*/HaskellObj *ret );
Capability *
rts_eval_ (Capability *, HaskellObj p, unsigned int stack_size,
/*out*/HaskellObj *ret);
SchedulerStatus
rts_evalIO ( HaskellObj p, /*out*/HaskellObj *ret );
Capability *
rts_evalIO (Capability *, HaskellObj p, /*out*/HaskellObj *ret);
SchedulerStatus
rts_evalStableIO ( HsStablePtr s, /*out*/HsStablePtr *ret );
Capability *
rts_evalStableIO (Capability *, HsStablePtr s, /*out*/HsStablePtr *ret);
SchedulerStatus
rts_evalLazyIO ( HaskellObj p, /*out*/HaskellObj *ret );
Capability *
rts_evalLazyIO (Capability *, HaskellObj p, /*out*/HaskellObj *ret);
SchedulerStatus
rts_evalLazyIO_ ( HaskellObj p, unsigned int stack_size, /*out*/HaskellObj *ret );
Capability *
rts_evalLazyIO_ (Capability *, HaskellObj p, unsigned int stack_size,
/*out*/HaskellObj *ret);
void
rts_checkSchedStatus ( char* site, SchedulerStatus rc);
rts_checkSchedStatus (char* site, Capability *);
SchedulerStatus
rts_getSchedStatus (Capability *cap);
/* --------------------------------------------------------------------------
Wrapper closures
......
......@@ -21,10 +21,6 @@
#define SUPPORT_LONG_LONGS 1
#endif
#if defined(SMP) || defined(THREADED_RTS)
#define RTS_SUPPORTS_THREADS 1
#endif
/*
* Whether the runtime system will use libbfd for debugging purposes.
*/
......@@ -43,6 +39,7 @@
/* TICKY_TICKY needs EAGER_BLACKHOLING to verify no double-entries of
* single-entry thunks.
*/
//#if defined(TICKY_TICKY) || defined(SMP)
#if defined(TICKY_TICKY)
# define EAGER_BLACKHOLING
#else
......
......@@ -54,8 +54,11 @@ extern StgInt isFloatDenormalized(StgFloat f);
extern StgInt isFloatNegativeZero(StgFloat f);
/* Suspending/resuming threads around foreign calls */
extern StgInt suspendThread ( StgRegTable * );
extern StgRegTable * resumeThread ( StgInt );
extern void * suspendThread ( StgRegTable * );
extern StgRegTable * resumeThread ( void * );
/* scheduler stuff */
extern void stg_scheduleThread (StgRegTable *reg, struct StgTSO_ *tso);
/* Creating and destroying an adjustor thunk */
extern void* createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr,
......@@ -69,7 +72,9 @@ extern void rts_ConsoleHandlerDone ( int ev );
extern int stg_sig_install (int, int, StgStablePtr *, void *);
#endif
extern void startSignalHandler(int sig);
#if !defined(mingw32_HOST_OS)
extern StgInt *signal_handlers;
#endif
extern void setIOManagerPipe (int fd);
extern void* stgMallocBytesRWX(int len);
......
......@@ -64,8 +64,8 @@ extern void stmPreGCHook(void);
/* Create and enter a new transaction context */
extern StgTRecHeader *stmStartTransaction(StgRegTable *reg, StgTRecHeader *outer);
extern StgTRecHeader *stmStartNestedTransaction(StgRegTable *reg, StgTRecHeader *outer
extern StgTRecHeader *stmStartTransaction(Capability *cap, StgTRecHeader *outer);
extern StgTRecHeader *stmStartNestedTransaction(Capability *cap, StgTRecHeader *outer
);
/*
......@@ -158,8 +158,8 @@ extern StgBool stmValidateNestOfTransactions(StgTRecHeader *trec);
* been committed to.
*/
extern StgBool stmCommitTransaction(StgRegTable *reg, StgTRecHeader *trec);
extern StgBool stmCommitNestedTransaction(StgRegTable *reg, StgTRecHeader *trec);
extern StgBool stmCommitTransaction(Capability *cap, StgTRecHeader *trec);
extern StgBool stmCommitNestedTransaction(Capability *cap, StgTRecHeader *trec);
/*
* Test whether the current transaction context is valid and, if so,
......@@ -168,7 +168,7 @@ extern StgBool stmCommitNestedTransaction(StgRegTable *reg, StgTRecHeader *trec)
* if the thread is already waiting.
*/
extern StgBool stmWait(StgRegTable *reg,
extern StgBool stmWait(Capability *cap,
StgTSO *tso,
StgTRecHeader *trec);
......@@ -188,7 +188,7 @@ extern StgBool stmReWait(StgTSO *tso);
--------------------------
*/
extern StgTVar *stmNewTVar(StgRegTable *reg,
extern StgTVar *stmNewTVar(Capability *cap,
StgClosure *new_value);
/*----------------------------------------------------------------------
......@@ -202,7 +202,7 @@ extern StgTVar *stmNewTVar(StgRegTable *reg,
* thread's current transaction.
*/
extern StgClosure *stmReadTVar(StgRegTable *reg,
extern StgClosure *stmReadTVar(Capability *cap,
StgTRecHeader *trec,
StgTVar *tvar);
......@@ -210,7 +210,7 @@ extern StgClosure *stmReadTVar(StgRegTable *reg,
* thread's current transaction.
*/
extern void stmWriteTVar(StgRegTable *reg,
extern void stmWriteTVar(Capability *cap,
StgTRecHeader *trec,
StgTVar *tvar,
StgClosure *new_value);
......
......@@ -15,84 +15,22 @@
#define NO_PRI 0
#endif
extern SchedulerStatus waitThread(StgTSO *main_thread, /*out*/StgClosure **ret,
Capability *initialCapability);
/*
* Creating threads
*/
#if defined(GRAN)
extern StgTSO *createThread(nat stack_size, StgInt pri);
#else
extern StgTSO *createThread(nat stack_size);
#endif
extern void scheduleThread(StgTSO *tso);
extern SchedulerStatus scheduleWaitThread(StgTSO *tso, /*out*/HaskellObj* ret,
Capability *initialCapability);
INLINE_HEADER void pushClosure (StgTSO *tso, StgWord c) {
tso->sp--;
tso->sp[0] = (W_) c;
}
INLINE_HEADER StgTSO *
createGenThread(nat stack_size, StgClosure *closure) {
StgTSO *t;
#if defined(GRAN)
t = createThread(stack_size, NO_PRI);
#else
t = createThread(stack_size);
#endif
pushClosure(t, (W_)closure);
pushClosure(t, (W_)&stg_enter_info);
return t;
}
INLINE_HEADER StgTSO *
createIOThread(nat stack_size, StgClosure *closure) {
StgTSO *t;
#if defined(GRAN)
t = createThread(stack_size, NO_PRI);
#else
t = createThread(stack_size);
#endif
pushClosure(t, (W_)&stg_noforceIO_info);
pushClosure(t, (W_)&stg_ap_v_info);
pushClosure(t, (W_)closure);
pushClosure(t, (W_)&stg_enter_info);
return t;
}
/*
* Same as above, but also evaluate the result of the IO action
* to whnf while we're at it.
*/
INLINE_HEADER StgTSO *
createStrictIOThread(nat stack_size, StgClosure *closure) {
StgTSO *t;
#if defined(GRAN)
t = createThread(stack_size, NO_PRI);
StgTSO *createThread (Capability *cap, nat stack_size, StgInt pri);
#else
t = createThread(stack_size);
StgTSO *createThread (Capability *cap, nat stack_size);
#endif
pushClosure(t, (W_)&stg_forceIO_info);
pushClosure(t, (W_)&stg_ap_v_info);
pushClosure(t, (W_)closure);
pushClosure(t, (W_)&stg_enter_info);
return t;
}
/*
* Killing threads
*/
extern void deleteThread(StgTSO *tso);
extern void deleteAllThreads ( void );
extern int howManyThreadsAvail ( void );
/*
* Run until there are no more threads.
*/
extern void finishAllThreads ( void );
Capability *scheduleWaitThread (StgTSO *tso, /*out*/HaskellObj* ret,
Capability *cap);
StgTSO *createGenThread (Capability *cap, nat stack_size,
StgClosure *closure);
StgTSO *createIOThread (Capability *cap, nat stack_size,
StgClosure *closure);
StgTSO *createStrictIOThread (Capability *cap, nat stack_size,
StgClosure *closure);
#endif
......@@ -145,7 +145,7 @@ extern void exitStorage(void);
-------------------------------------------------------------------------- */
extern StgPtr allocate ( nat n );
extern StgPtr allocateLocal ( StgRegTable *reg, nat n );
extern StgPtr allocateLocal ( Capability *cap, nat n );
extern StgPtr allocatePinned ( nat n );
extern lnat allocated_bytes ( void );
......@@ -205,9 +205,11 @@ extern Mutex sm_mutex;
#if defined(SMP)
#define ACQUIRE_SM_LOCK ACQUIRE_LOCK(&sm_mutex);
#define RELEASE_SM_LOCK RELEASE_LOCK(&sm_mutex);
#define ASSERT_SM_LOCK() ASSERT_LOCK_HELD(&sm_mutex);
#else
#define ACQUIRE_SM_LOCK
#define RELEASE_SM_LOCK
#define ASSERT_SM_LOCK()
#endif
INLINE_HEADER void
......
......@@ -133,7 +133,7 @@ typedef struct StgTSO_ {
struct StgTSO_* blocked_exceptions;
StgThreadID id;
int saved_errno;
struct StgMainThread_* main;
struct Task_* bound; // non-NULL for a bound thread
struct StgTRecHeader_ *trec; /* STM transaction record */
#ifdef TICKY_TICKY
......
......@@ -270,7 +270,8 @@ DEBUG_FILL_SLOP(StgClosure *p)
\
/* ASSERT( p1 != p2 && !closure_IND(p1) ); \
*/ LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1); \
bd = Bdescr(p1); \
/* foreign "C" cas(p1 "ptr", 0, stg_WHITEHOLE_info); \
*/ bd = Bdescr(p1); \
if (bdescr_gen_no(bd) == 0 :: CInt) { \
StgInd_indirectee(p1) = p2; \
SET_INFO(p1, ind_info); \
......@@ -292,6 +293,7 @@ DEBUG_FILL_SLOP(StgClosure *p)
{ \
bdescr *bd; \
\
/* cas(p1, 0, &stg_WHITEHOLE_info); */ \
ASSERT( (P_)p1 != (P_)p2 && !closure_IND(p1) ); \
LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1); \
bd = Bdescr((P_)p1); \
......
......@@ -22,6 +22,8 @@
#include "Rts.h"
#include "RtsFlags.h"
#include "Storage.h"
#include "OSThreads.h"
#include "Capability.h"