#include "PosixSource.h"
#include "Rts.h"
-#include "OSThreads.h"
#include "RtsAPI.h"
-#include "SchedAPI.h"
-#include "RtsFlags.h"
+#include "HsFFI.h"
+
#include "RtsUtils.h"
#include "Prelude.h"
#include "Schedule.h"
#include "Capability.h"
#include "Stable.h"
-
-#include <stdlib.h>
+#include "Weak.h"
/* ----------------------------------------------------------------------------
Building Haskell objects from C datatypes.
HaskellObj
rts_mkChar (Capability *cap, HsChar c)
{
- StgClosure *p = (StgClosure *)allocateLocal(cap, CONSTR_sizeW(0,1));
+ StgClosure *p = (StgClosure *)allocate(cap, CONSTR_sizeW(0,1));
SET_HDR(p, Czh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgWord)(StgChar)c;
return p;
HaskellObj
rts_mkInt (Capability *cap, HsInt i)
{
- StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
SET_HDR(p, Izh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgInt)i;
return p;
HaskellObj
rts_mkInt8 (Capability *cap, HsInt8 i)
{
- StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+ StgClosure *p = (StgClosure *)allocate(cap,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);
+ p->payload[0] = (StgClosure *)(StgInt)i;
return p;
}
HaskellObj
rts_mkInt16 (Capability *cap, HsInt16 i)
{
- StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+ StgClosure *p = (StgClosure *)allocate(cap,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);
+ p->payload[0] = (StgClosure *)(StgInt)i;
return p;
}
HaskellObj
rts_mkInt32 (Capability *cap, HsInt32 i)
{
- StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
SET_HDR(p, I32zh_con_info, CCS_SYSTEM);
- p->payload[0] = (StgClosure *)(StgInt)((unsigned)i & 0xffffffff);
+ p->payload[0] = (StgClosure *)(StgInt)i;
return p;
}
HaskellObj
rts_mkInt64 (Capability *cap, HsInt64 i)
{
- llong *tmp;
- StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,2));
+ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,2));
SET_HDR(p, I64zh_con_info, CCS_SYSTEM);
- tmp = (llong*)&(p->payload[0]);
- *tmp = (StgInt64)i;
+ ASSIGN_Int64((P_)&(p->payload[0]), i);
return p;
}
HaskellObj
rts_mkWord (Capability *cap, HsWord i)
{
- StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
SET_HDR(p, Wzh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgWord)i;
return p;
rts_mkWord8 (Capability *cap, HsWord8 w)
{
/* see rts_mkInt* comments */
- StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
SET_HDR(p, W8zh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgWord)(w & 0xff);
return p;
rts_mkWord16 (Capability *cap, HsWord16 w)
{
/* see rts_mkInt* comments */
- StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
SET_HDR(p, W16zh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgWord)(w & 0xffff);
return p;
rts_mkWord32 (Capability *cap, HsWord32 w)
{
/* see rts_mkInt* comments */
- StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
SET_HDR(p, W32zh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgWord)(w & 0xffffffff);
return p;
HaskellObj
rts_mkWord64 (Capability *cap, HsWord64 w)
{
- ullong *tmp;
-
- StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,2));
+ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,2));
/* see mk_Int8 comment */
SET_HDR(p, W64zh_con_info, CCS_SYSTEM);
- tmp = (ullong*)&(p->payload[0]);
- *tmp = (StgWord64)w;
+ ASSIGN_Word64((P_)&(p->payload[0]), w);
return p;
}
+
HaskellObj
rts_mkFloat (Capability *cap, HsFloat f)
{
- StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
SET_HDR(p, Fzh_con_info, CCS_SYSTEM);
ASSIGN_FLT((P_)p->payload, (StgFloat)f);
return p;
HaskellObj
rts_mkDouble (Capability *cap, HsDouble d)
{
- StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,sizeofW(StgDouble)));
+ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,sizeofW(StgDouble)));
SET_HDR(p, Dzh_con_info, CCS_SYSTEM);
ASSIGN_DBL((P_)p->payload, (StgDouble)d);
return p;
HaskellObj
rts_mkStablePtr (Capability *cap, HsStablePtr s)
{
- StgClosure *p = (StgClosure *)allocateLocal(cap,sizeofW(StgHeader)+1);
+ StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1);
SET_HDR(p, StablePtr_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)s;
return p;
HaskellObj
rts_mkPtr (Capability *cap, HsPtr a)
{
- StgClosure *p = (StgClosure *)allocateLocal(cap,sizeofW(StgHeader)+1);
+ StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1);
SET_HDR(p, Ptr_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)a;
return p;
HaskellObj
rts_mkFunPtr (Capability *cap, HsFunPtr a)
{
- StgClosure *p = (StgClosure *)allocateLocal(cap,sizeofW(StgHeader)+1);
+ StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1);
SET_HDR(p, FunPtr_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)a;
return p;
{
StgThunk *ap;
- ap = (StgThunk *)allocateLocal(cap,sizeofW(StgThunk) + 2);
+ ap = (StgThunk *)allocate(cap,sizeofW(StgThunk) + 2);
SET_HDR(ap, (StgInfoTable *)&stg_ap_2_upd_info, CCS_SYSTEM);
ap->payload[0] = f;
ap->payload[1] = arg;
HsInt64
rts_getInt64 (HaskellObj p)
{
- HsInt64* tmp;
// See comment above:
// ASSERT(p->header.info == I64zh_con_info ||
// p->header.info == I64zh_static_info);
- tmp = (HsInt64*)&(UNTAG_CLOSURE(p)->payload[0]);
- return *tmp;
+ return PK_Int64((P_)&(UNTAG_CLOSURE(p)->payload[0]));
}
+
HsWord
rts_getWord (HaskellObj p)
{
return (HsWord32)(HsWord)(UNTAG_CLOSURE(p)->payload[0]);
}
-
HsWord64
rts_getWord64 (HaskellObj p)
{
- HsWord64* tmp;
// See comment above:
// ASSERT(p->header.info == W64zh_con_info ||
// p->header.info == W64zh_static_info);
- tmp = (HsWord64*)&(UNTAG_CLOSURE(p)->payload[0]);
- return *tmp;
+ return PK_Word64((P_)&(UNTAG_CLOSURE(p)->payload[0]));
}
HsFloat
createGenThread (Capability *cap, nat stack_size, StgClosure *closure)
{
StgTSO *t;
-#if defined(GRAN)
- t = createThread (cap, stack_size, NO_PRI);
-#else
t = createThread (cap, stack_size);
-#endif
pushClosure(t, (W_)closure);
pushClosure(t, (W_)&stg_enter_info);
return t;
createIOThread (Capability *cap, nat stack_size, StgClosure *closure)
{
StgTSO *t;
-#if defined(GRAN)
- t = createThread (cap, stack_size, NO_PRI);
-#else
t = createThread (cap, stack_size);
-#endif
pushClosure(t, (W_)&stg_noforceIO_info);
pushClosure(t, (W_)&stg_ap_v_info);
pushClosure(t, (W_)closure);
createStrictIOThread(Capability *cap, nat stack_size, StgClosure *closure)
{
StgTSO *t;
-#if defined(GRAN)
- t = createThread(cap, stack_size, NO_PRI);
-#else
t = createThread(cap, stack_size);
-#endif
pushClosure(t, (W_)&stg_forceIO_info);
pushClosure(t, (W_)&stg_ap_v_info);
pushClosure(t, (W_)closure);
Capability *cap;
Task *task;
- // ToDo: get rid of this lock in the common case. We could store
- // a free Task in thread-local storage, for example. That would
- // leave just one lock on the path into the RTS: cap->lock when
- // acquiring the Capability.
- ACQUIRE_LOCK(&sched_mutex);
+ if (running_finalizers) {
+ errorBelch("error: a C finalizer called back into Haskell.\n"
+ " This was previously allowed, but is disallowed in GHC 6.10.2 and later.\n"
+ " To create finalizers that may call back into Haskll, use\n"
+ " Foreign.Concurrent.newForeignPtr instead of Foreign.newForeignPtr.");
+ stg_exit(EXIT_FAILURE);
+ }
+
task = newBoundTask();
- RELEASE_LOCK(&sched_mutex);
cap = NULL;
waitForReturnCapability(&cap, task);
task = cap->running_task;
ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
- // slightly delicate ordering of operations below, pay attention!
-
- // We are no longer a bound task/thread. This is important,
- // because the GC can run when we release the Capability below,
- // and we don't want it to treat this as a live TSO pointer.
- task->tso = NULL;
-
// Now release the Capability. With the capability released, GC
// may happen. NB. does not try to put the current Task on the
// worker queue.
- releaseCapability(cap);
+ // NB. keep cap->lock held while we call boundTaskExiting(). This
+ // is necessary during shutdown, where we want the invariant that
+ // after shutdownCapability(), all the Tasks associated with the
+ // Capability have completed their shutdown too. Otherwise we
+ // could have boundTaskExiting()/workerTaskStop() running at some
+ // random point in the future, which causes problems for
+ // freeTaskManager().
+ ACQUIRE_LOCK(&cap->lock);
+ releaseCapability_(cap,rtsFalse);
// Finally, we can release the Task to the free list.
boundTaskExiting(task);
+ RELEASE_LOCK(&cap->lock);
}
projects / ghc-hetmet.git / blobdiff