Commit af136096 authored by wolfgang's avatar wolfgang
Browse files

[project @ 2003-01-25 15:54:48 by wolfgang]

This commit fixes many bugs and limitations in the threaded RTS.
There are still some issues remaining, though.

The following bugs should have been fixed:

- [+] "safe" calls could cause crashes
- [+] yieldToReturningWorker/grabReturnCapability
    -     It used to deadlock.
- [+] couldn't wake blocked workers
    -     Calls into the RTS could go unanswered for a long time, and
          that includes ordinary callbacks in some circumstances.
- [+] couldn't block on an MVar and expect to be woken up by a signal
      handler
    -     Depending on the exact situation, the RTS shut down or
          blocked forever and ignored the signal.
- [+] The locking scheme in RtsAPI.c didn't work
- [+] run_thread label in wrong place (schedule())
- [+] Deadlock in GHC.Handle
    -     if a signal arrived at the wrong time, an mvar was never
          filled again
- [+] Signals delivered to the "wrong" thread were ignored or handled
      too late.

Issues:
*) If GC can move TSO objects (I don't know - can it?), then ghci
will occasionally crash when calling foreign functions, because the
parameters are stored on the TSO stack.

*) There is still a race condition lurking in the code
(both threaded and non-threaded RTS are affected):
If a signal arrives after the check for pending signals in
schedule(), but before the call to select() in awaitEvent(),
select() will be called anyway. The signal handler will be
executed much later than expected.

*) For Win32, GHC doesn't yet support non-blocking IO, so while a
thread is waiting for IO, no call-ins can happen. If the RTS is
blocked in awaitEvent, it uses a polling loop on Win32, so call-ins
should work (although the polling loop looks ugly).

*) Deadlock detection is disabled for the threaded rts, because I
don't know how to do it properly in the presence of foreign call-ins
from foreign threads.
This causes the tests conc031, conc033 and conc034 to fail.

*) "safe" is currently treated as "threadsafe". Implementing "safe" in
a way that blocks other Haskell threads is more difficult than was
thought at first. I think it could be done with a few additional lines
of code, but personally, I'm strongly in favour of abolishing the
distinction.

*) Running finalizers at program termination is inefficient - there
are two OS threads passing messages back and forth for every finalizer
that is run. Also (just as in the non-threaded case) the finalizers
are run in parallel to any remaining haskell threads and to any
foreign call-ins that might still happen.
parent be659293
......@@ -450,9 +450,12 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
-- various other bits for inside the fn
declareResult = text "HaskellObj ret;"
declareCResult | res_hty_is_unit = empty
| otherwise = cResType <+> text "cret;"
return_what | res_hty_is_unit = empty
| otherwise = parens (unpackHObj res_hty <> parens (text "ret"))
assignCResult | res_hty_is_unit = empty
| otherwise =
text "cret=" <> unpackHObj res_hty <> parens (text "ret") <> semi
-- an extern decl for the fn being called
extern_decl
......@@ -469,6 +472,8 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
[ lbrace
, text "SchedulerStatus rc;"
, declareResult
, declareCResult
, text "rts_lock();"
-- create the application + perform it.
, text "rc=rts_evalIO" <> parens (
text "rts_apply" <> parens (
......@@ -483,7 +488,10 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
) <> semi
, text "rts_checkSchedStatus" <> parens (doubleQuotes (ftext c_nm)
<> comma <> text "rc") <> semi
, text "return" <> return_what <> semi
, assignCResult
, text "rts_unlock();"
, if res_hty_is_unit then empty
else text "return cret;"
, rbrace
]
......
/* ----------------------------------------------------------------------------
* $Id: RtsAPI.h,v 1.30 2002/09/05 08:58:55 simonmar Exp $
* $Id: RtsAPI.h,v 1.31 2003/01/25 15:54:48 wolfgang Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -38,6 +38,20 @@ extern void shutdownHaskellAndExit ( int exitCode );
extern void setProgArgv ( int argc, char *argv[] );
extern void getProgArgv ( int *argc, char **argv[] );
/* ----------------------------------------------------------------------------
Locking.
In a multithreaded environments, you have to surround all access to the
RtsAPI with these calls.
------------------------------------------------------------------------- */
void
rts_lock ( void );
void
rts_unlock ( void );
/* ----------------------------------------------------------------------------
Building Haskell objects from C datatypes.
------------------------------------------------------------------------- */
......@@ -85,6 +99,8 @@ HsBool rts_getBool ( HaskellObj );
Evaluating Haskell expressions
The versions ending in '_' allow you to specify an initial stack size.
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 );
......
/* -----------------------------------------------------------------------------
* $Id: TSO.h,v 1.28 2002/12/11 15:36:40 simonmar Exp $
* $Id: TSO.h,v 1.29 2003/01/25 15:54:48 wolfgang Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -144,7 +144,9 @@ typedef enum {
, BlockedOnGA_NoSend // same as above but without sending a Fetch message
#endif
#if defined(RTS_SUPPORTS_THREADS)
, BlockedOnCCall
, BlockedOnCCall
, BlockedOnCCall_NoUnblockExc // same as above but don't unblock async exceptions
// in resumeThread()
#endif
} StgTSOBlockReason;
......
/* -----------------------------------------------------------------------------
* $Id: Updates.h,v 1.28 2002/12/11 15:36:40 simonmar Exp $
* $Id: Updates.h,v 1.29 2003/01/25 15:54:48 wolfgang Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -93,6 +93,30 @@
(StgClosure *)updclosure, \
(StgClosure *)heapptr); \
}
#elif defined(RTS_SUPPORTS_THREADS)
# ifdef TICKY_TICKY
# define UPD_IND_NOLOCK(updclosure, heapptr) \
{ \
const StgInfoTable *info; \
info = ((StgClosure *)updclosure)->header.info; \
AWAKEN_BQ_NOLOCK(info,updclosure); \
updateWithPermIndirection(info, \
(StgClosure *)updclosure, \
(StgClosure *)heapptr); \
}
# else
# define UPD_IND_NOLOCK(updclosure, heapptr) \
{ \
const StgInfoTable *info; \
info = ((StgClosure *)updclosure)->header.info; \
AWAKEN_BQ_NOLOCK(info,updclosure); \
updateWithIndirection(info, \
(StgClosure *)updclosure, \
(StgClosure *)heapptr); \
}
# endif
#else
#define UPD_IND_NOLOCK(updclosure,heapptr) UPD_IND(updclosure,heapptr)
#endif
......@@ -171,6 +195,17 @@ extern void awakenBlockedQueue(StgTSO *q);
DO_AWAKEN_BQ(closure); \
}
#ifdef RTS_SUPPORTS_THREADS
extern void awakenBlockedQueueNoLock(StgTSO *q);
#define DO_AWAKEN_BQ_NOLOCK(closure) \
STGCALL1(awakenBlockedQueueNoLock, \
((StgBlockingQueue *)closure)->blocking_queue);
#define AWAKEN_BQ_NOLOCK(info,closure) \
if (info == &stg_BLACKHOLE_BQ_info) { \
DO_AWAKEN_BQ_NOLOCK(closure); \
}
#endif
#endif /* GRAN || PAR */
/* -------------------------------------------------------------------------
......
......@@ -21,6 +21,7 @@
#include "OSThreads.h"
#include "Capability.h"
#include "Schedule.h" /* to get at EMPTY_RUN_QUEUE() */
#include "Signals.h" /* to get at handleSignalsInThisThread() */
#if !defined(SMP)
Capability MainCapability; /* for non-SMP, we have one global capability */
......@@ -44,7 +45,7 @@ Condition returning_worker_cond = INIT_COND_VAR;
* there are one or more worker threads blocked waiting on
* returning_worker_cond.
*/
static nat rts_n_waiting_workers = 0;
nat rts_n_waiting_workers = 0;
/* thread_ready_cond: when signalled, a thread has become runnable for a
* task to execute.
......@@ -53,14 +54,10 @@ static nat rts_n_waiting_workers = 0;
* exclusive access to the RTS and all its data structures (that are not
* locked by the Scheduler's mutex).
*
* thread_ready_cond is signalled whenever COND_NO_THREADS_READY doesn't hold.
* thread_ready_cond is signalled whenever noCapabilities doesn't hold.
*
*/
Condition thread_ready_cond = INIT_COND_VAR;
#if 0
/* For documentation purposes only */
#define COND_NO_THREADS_READY() (noCapabilities() || EMPTY_RUN_QUEUE())
#endif
/*
* To be able to make an informed decision about whether or not
......@@ -119,6 +116,8 @@ initCapabilities()
#if defined(SMP)
/* Free capability list. */
static Capability *free_capabilities; /* Available capabilities for running threads */
static Capability *returning_capabilities;
/* Capabilities being passed to returning worker threads */
#endif
/* -----------------------------------------------------------------------------
......@@ -138,9 +137,11 @@ static Capability *free_capabilities; /* Available capabilities for running thre
*/
void grabCapability(Capability** cap)
{
ASSERT(rts_n_free_capabilities > 0);
#if !defined(SMP)
rts_n_free_capabilities = 0;
*cap = &MainCapability;
handleSignalsInThisThread();
#else
*cap = free_capabilities;
free_capabilities = (*cap)->link;
......@@ -161,16 +162,11 @@ void releaseCapability(Capability* cap
STG_UNUSED
#endif
)
{
#if defined(SMP)
cap->link = free_capabilities;
free_capabilities = cap;
rts_n_free_capabilities++;
#else
rts_n_free_capabilities = 1;
#endif
{ // Precondition: sched_mutex must be held
#if defined(RTS_SUPPORTS_THREADS)
#ifndef SMP
ASSERT(rts_n_free_capabilities == 0);
#endif
/* Check to see whether a worker thread can be given
the go-ahead to return the result of an external call..*/
if (rts_n_waiting_workers > 0) {
......@@ -178,14 +174,27 @@ void releaseCapability(Capability* cap
* thread that is yielding its capability will repeatedly
* signal returning_worker_cond.
*/
#if defined(SMP)
// SMP variant untested
cap->link = returning_capabilities;
returning_capabilities = cap;
#else
#endif
rts_n_waiting_workers--;
signalCondition(&returning_worker_cond);
} else if ( !EMPTY_RUN_QUEUE() ) {
/* Signal that work is available */
} else /*if ( !EMPTY_RUN_QUEUE() )*/ {
#if defined(SMP)
cap->link = free_capabilities;
free_capabilities = cap;
rts_n_free_capabilities++;
#else
rts_n_free_capabilities = 1;
#endif
/* Signal that a capability is available */
signalCondition(&thread_ready_cond);
}
#endif
return;
return;
}
#if defined(RTS_SUPPORTS_THREADS)
......@@ -226,15 +235,25 @@ grabReturnCapability(Mutex* pMutex, Capability** pCap)
{
IF_DEBUG(scheduler,
fprintf(stderr,"worker (%ld): returning, waiting for lock.\n", osThreadId()));
rts_n_waiting_workers++;
IF_DEBUG(scheduler,
fprintf(stderr,"worker (%ld): returning; workers waiting: %d\n",
osThreadId(), rts_n_waiting_workers));
while ( noCapabilities() ) {
if ( noCapabilities() ) {
rts_n_waiting_workers++;
wakeBlockedWorkerThread();
context_switch = 1; // make sure it's our turn soon
waitCondition(&returning_worker_cond, pMutex);
#if defined(SMP)
*pCap = returning_capabilities;
returning_capabilities = (*pCap)->link;
#else
*pCap = &MainCapability;
ASSERT(rts_n_free_capabilities == 0);
handleSignalsInThisThread();
#endif
} else {
grabCapability(pCap);
}
grabCapability(pCap);
return;
}
......@@ -253,18 +272,21 @@ grabReturnCapability(Mutex* pMutex, Capability** pCap)
*
* Pre-condition: pMutex is assumed held and the thread possesses
* a Capability.
* Post-condition: pMutex isn't held and the Capability has
* Post-condition: pMutex is held and the Capability has
* been given back.
*/
void
yieldToReturningWorker(Mutex* pMutex, Capability** pCap)
{
if ( rts_n_waiting_workers > 0 && noCapabilities() ) {
if ( rts_n_waiting_workers > 0 ) {
IF_DEBUG(scheduler,
fprintf(stderr,"worker thread (%ld): giving up RTS token\n", osThreadId()));
fprintf(stderr,"worker thread (%p): giving up RTS token\n", osThreadId()));
releaseCapability(*pCap);
/* And wait for work */
/* And wait for work */
waitForWorkCapability(pMutex, pCap, rtsFalse);
IF_DEBUG(scheduler,
fprintf(stderr,"worker thread (%p): got back RTS token (after yieldToReturningWorker)\n",
osThreadId()));
}
return;
}
......@@ -281,6 +303,7 @@ yieldToReturningWorker(Mutex* pMutex, Capability** pCap)
* call is made.
*
* Pre-condition: pMutex is held.
* Post-condition: pMutex is held and *pCap is held by the current thread
*/
void
waitForWorkCapability(Mutex* pMutex, Capability** pCap, rtsBool runnable)
......@@ -293,6 +316,7 @@ waitForWorkCapability(Mutex* pMutex, Capability** pCap, rtsBool runnable)
grabCapability(pCap);
return;
}
#endif /* RTS_SUPPORTS_THREADS */
#if defined(SMP)
......@@ -319,6 +343,7 @@ initCapabilities_(nat n)
}
free_capabilities = cap;
rts_n_free_capabilities = n;
returning_capabilities = NULL;
IF_DEBUG(scheduler,fprintf(stderr,"scheduler: Allocated %d capabilities\n", n_free_capabilities););
}
#endif /* SMP */
......
......@@ -34,17 +34,20 @@ extern void releaseCapability(Capability* cap);
extern nat rts_n_free_capabilities;
#if defined(RTS_SUPPORTS_THREADS)
/* number of worker threads waiting to do good work within
the RTS. Used by Task.c (only) to determine whether or not
new worker threads needs to be created (when an external call
is made).
/* number of worker threads waiting for a return capability
*/
extern nat rts_n_waiting_workers; /* used by Task.c to determine */
extern nat rts_n_waiting_workers;
extern void grabReturnCapability(Mutex* pMutex, Capability** pCap);
extern void yieldToReturningWorker(Mutex* pMutex, Capability** pCap);
extern void waitForWorkCapability(Mutex* pMutex, Capability** pCap, rtsBool runnable);
static inline rtsBool needToYieldToReturningWorker(void)
{
return rts_n_waiting_workers > 0;
}
static inline nat getFreeCapabilities (void)
{
return rts_n_free_capabilities;
......
......@@ -1157,6 +1157,7 @@ run_BCO:
int stk_offset = BCO_NEXT;
int o_itbl = BCO_NEXT;
void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl);
StgTSO *tso = cap->r.rCurrentTSO;
// There are a bunch of non-ptr words on the stack (the
// ccall args, the ccall fun address and space for the
......@@ -1175,12 +1176,17 @@ run_BCO:
SAVE_STACK_POINTERS;
tok = suspendThread(&cap->r,rtsFalse);
// Careful: suspendThread might have shifted the stack
// Careful:
// suspendThread might have shifted the stack
// around (stack squeezing), so we have to grab the real
// Sp out of the TSO to find the ccall args again:
marshall_fn ( (void*)(cap->r.rCurrentTSO->sp + RET_DYN_SIZE
+ sizeofW(StgRetDyn)) );
// Sp out of the TSO to find the ccall args again.
// We don't own the capability anymore, so we mustn't use it.
// Instead, we have to save the TSO ptr beforehand.
// Also note that GC may strike at any time now (from another thread).
// FIXME - DANGER!! Can GC move our TSO?
// If so, we have to copy the args elsewhere!
marshall_fn ( (void*)(tso->sp + RET_DYN_SIZE + sizeofW(StgRetDyn)) );
// And restart the thread again, popping the RET_DYN frame.
cap = (Capability *)((void *)resumeThread(tok,rtsFalse) - sizeof(StgFunTable));
LOAD_STACK_POINTERS;
......
/* ----------------------------------------------------------------------------
* $Id: RtsAPI.c,v 1.38 2002/12/11 15:36:47 simonmar Exp $
* $Id: RtsAPI.c,v 1.39 2003/01/25 15:54:49 wolfgang Exp $
*
* (c) The GHC Team, 1998-2001
*
......@@ -17,60 +17,17 @@
#include "Prelude.h"
#include "OSThreads.h"
#include "Schedule.h"
#include "Capability.h"
#include <stdlib.h>
#if defined(RTS_SUPPORTS_THREADS)
/* Cheesy locking scheme while waiting for the
* RTS API to change.
*/
static Mutex alloc_mutex = INIT_MUTEX_VAR;
static Condition alloc_cond = INIT_COND_VAR;
#define INVALID_THREAD_ID ((OSThreadId)(-1))
/* Thread currently owning the allocator */
static OSThreadId c_id = INVALID_THREAD_ID;
static StgPtr alloc(nat n)
{
OSThreadId tid = osThreadId();
ACQUIRE_LOCK(&alloc_mutex);
if (tid == c_id) {
/* I've got the lock, just allocate() */
;
} else if (c_id == INVALID_THREAD_ID) {
c_id = tid;
} else {
waitCondition(&alloc_cond, &alloc_mutex);
c_id = tid;
}
RELEASE_LOCK(&alloc_mutex);
return allocate(n);
}
static void releaseAllocLock(void)
{
ACQUIRE_LOCK(&alloc_mutex);
/* Reset the allocator owner */
c_id = INVALID_THREAD_ID;
RELEASE_LOCK(&alloc_mutex);
/* Free up an OS thread waiting to get in */
signalCondition(&alloc_cond);
}
#else
# define alloc(n) allocate(n)
# define releaseAllocLock() /* nothing */
#endif
/* ----------------------------------------------------------------------------
Building Haskell objects from C datatypes.
------------------------------------------------------------------------- */
HaskellObj
rts_mkChar (HsChar c)
{
StgClosure *p = (StgClosure *)alloc(CONSTR_sizeW(0,1));
StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
SET_HDR(p, Czh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgChar)c;
return p;
......@@ -79,7 +36,7 @@ rts_mkChar (HsChar c)
HaskellObj
rts_mkInt (HsInt i)
{
StgClosure *p = (StgClosure *)alloc(CONSTR_sizeW(0,1));
StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
SET_HDR(p, Izh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgInt)i;
return p;
......@@ -88,7 +45,7 @@ rts_mkInt (HsInt i)
HaskellObj
rts_mkInt8 (HsInt8 i)
{
StgClosure *p = (StgClosure *)alloc(CONSTR_sizeW(0,1));
StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
SET_HDR(p, I8zh_con_info, CCS_SYSTEM);
/* Make sure we mask out the bits above the lowest 8 */
p->payload[0] = (StgClosure *)(StgInt)((unsigned)i & 0xff);
......@@ -98,7 +55,7 @@ rts_mkInt8 (HsInt8 i)
HaskellObj
rts_mkInt16 (HsInt16 i)
{
StgClosure *p = (StgClosure *)alloc(CONSTR_sizeW(0,1));
StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
SET_HDR(p, I16zh_con_info, CCS_SYSTEM);
/* Make sure we mask out the relevant bits */
p->payload[0] = (StgClosure *)(StgInt)((unsigned)i & 0xffff);
......@@ -108,7 +65,7 @@ rts_mkInt16 (HsInt16 i)
HaskellObj
rts_mkInt32 (HsInt32 i)
{
StgClosure *p = (StgClosure *)alloc(CONSTR_sizeW(0,1));
StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
SET_HDR(p, I32zh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgInt)((unsigned)i & 0xffffffff);
return p;
......@@ -118,7 +75,7 @@ HaskellObj
rts_mkInt64 (HsInt64 i)
{
long long *tmp;
StgClosure *p = (StgClosure *)alloc(CONSTR_sizeW(0,2));
StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,2));
SET_HDR(p, I64zh_con_info, CCS_SYSTEM);
tmp = (long long*)&(p->payload[0]);
*tmp = (StgInt64)i;
......@@ -128,7 +85,7 @@ rts_mkInt64 (HsInt64 i)
HaskellObj
rts_mkWord (HsWord i)
{
StgClosure *p = (StgClosure *)alloc(CONSTR_sizeW(0,1));
StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
SET_HDR(p, Wzh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgWord)i;
return p;
......@@ -138,7 +95,7 @@ HaskellObj
rts_mkWord8 (HsWord8 w)
{
/* see rts_mkInt* comments */
StgClosure *p = (StgClosure *)alloc(CONSTR_sizeW(0,1));
StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
SET_HDR(p, W8zh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgWord)(w & 0xff);
return p;
......@@ -148,7 +105,7 @@ HaskellObj
rts_mkWord16 (HsWord16 w)
{
/* see rts_mkInt* comments */
StgClosure *p = (StgClosure *)alloc(CONSTR_sizeW(0,1));
StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
SET_HDR(p, W16zh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgWord)(w & 0xffff);
return p;
......@@ -158,7 +115,7 @@ HaskellObj
rts_mkWord32 (HsWord32 w)
{
/* see rts_mkInt* comments */
StgClosure *p = (StgClosure *)alloc(CONSTR_sizeW(0,1));
StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
SET_HDR(p, W32zh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgWord)(w & 0xffffffff);
return p;
......@@ -169,7 +126,7 @@ rts_mkWord64 (HsWord64 w)
{
unsigned long long *tmp;
StgClosure *p = (StgClosure *)alloc(CONSTR_sizeW(0,2));
StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,2));
/* see mk_Int8 comment */
SET_HDR(p, W64zh_con_info, CCS_SYSTEM);
tmp = (unsigned long long*)&(p->payload[0]);
......@@ -180,7 +137,7 @@ rts_mkWord64 (HsWord64 w)
HaskellObj
rts_mkFloat (HsFloat f)
{
StgClosure *p = (StgClosure *)alloc(CONSTR_sizeW(0,1));
StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
SET_HDR(p, Fzh_con_info, CCS_SYSTEM);
ASSIGN_FLT((P_)p->payload, (StgFloat)f);
return p;
......@@ -189,7 +146,7 @@ rts_mkFloat (HsFloat f)
HaskellObj
rts_mkDouble (HsDouble d)
{
StgClosure *p = (StgClosure *)alloc(CONSTR_sizeW(0,sizeofW(StgDouble)));
StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,sizeofW(StgDouble)));
SET_HDR(p, Dzh_con_info, CCS_SYSTEM);
ASSIGN_DBL((P_)p->payload, (StgDouble)d);
return p;
......@@ -198,7 +155,7 @@ rts_mkDouble (HsDouble d)
HaskellObj
rts_mkStablePtr (HsStablePtr s)
{
StgClosure *p = (StgClosure *)alloc(sizeofW(StgHeader)+1);
StgClosure *p = (StgClosure *)allocate(sizeofW(StgHeader)+1);
SET_HDR(p, StablePtr_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)s;
return p;
......@@ -207,7 +164,7 @@ rts_mkStablePtr (HsStablePtr s)
HaskellObj
rts_mkPtr (HsPtr a)
{
StgClosure *p = (StgClosure *)alloc(sizeofW(StgHeader)+1);
StgClosure *p = (StgClosure *)allocate(sizeofW(StgHeader)+1);
SET_HDR(p, Ptr_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)a;
return p;
......@@ -236,7 +193,7 @@ rts_apply (HaskellObj f, HaskellObj arg)
{
StgClosure *ap;
ap = (StgClosure *)alloc(sizeofW(StgClosure) + 2);
ap = (StgClosure *)allocate(sizeofW(StgClosure) + 2);
SET_HDR(ap, (StgInfoTable *)&stg_ap_2_upd_info, CCS_SYSTEM);
ap->payload[0] = f;
ap->payload[1] = arg;
......@@ -414,7 +371,6 @@ rts_eval (HaskellObj p, /*out*/HaskellObj *ret)
StgTSO *tso;
tso = createGenThread(RtsFlags.GcFlags.initialStkSize, p);
releaseAllocLock();
return scheduleWaitThread(tso,ret);
}
......@@ -424,7 +380,6 @@ rts_eval_ (HaskellObj p, unsigned int stack_size, /*out*/HaskellObj *ret)
StgTSO *tso;
tso = createGenThread(stack_size, p);
releaseAllocLock();
return scheduleWaitThread(tso,ret);
}
......@@ -438,7 +393,6 @@ rts_evalIO (HaskellObj p, /*out*/HaskellObj *ret)
StgTSO* tso;
tso = createStrictIOThread(RtsFlags.GcFlags.initialStkSize, p);
releaseAllocLock();
return scheduleWaitThread(tso,ret);
}
......@@ -446,13 +400,13 @@ rts_evalIO (HaskellObj p, /*out*/HaskellObj *ret)
* Identical to rts_evalIO(), but won't create a new task/OS thread
* to evaluate the Haskell thread. Used by main() only. Hack.
*/
SchedulerStatus
rts_mainEvalIO(HaskellObj p, /*out*/HaskellObj *ret)
{
StgTSO* tso;
StgTSO* tso;
tso = createStrictIOThread(RtsFlags.GcFlags.initialStkSize, p);
releaseAllocLock();
scheduleThread(tso);
return waitThread(tso, ret);
}
......@@ -472,7 +426,6 @@ rts_evalStableIO (HsStablePtr s, /*out*/HsStablePtr *ret)
p = (StgClosure *)deRefStablePtr(s);
tso = createStrictIOThread(RtsFlags.GcFlags.initialStkSize, p);
releaseAllocLock();
stat = scheduleWaitThread(tso,&r);
if (stat == Success) {
......@@ -492,7 +445,6 @@ rts_evalLazyIO (HaskellObj p, unsigned int stack_size, /*out*/HaskellObj *ret)
StgTSO *tso;
tso = createIOThread(stack_size, p);
releaseAllocLock();
return scheduleWaitThread(tso,ret);
}