#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.
return p;
}
-
-#ifdef sparc_HOST_ARCH
-/* The closures returned by allocateLocal are only guaranteed to be 32 bit
- aligned, because that's the size of pointers. SPARC v9 can't do
- misaligned loads/stores, so we have to write the 64bit word in chunks */
-
-HaskellObj
-rts_mkInt64 (Capability *cap, HsInt64 i_)
-{
- StgInt64 i = (StgInt64)i_;
- StgInt32 *tmp;
-
- StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,2));
- SET_HDR(p, I64zh_con_info, CCS_SYSTEM);
-
- tmp = (StgInt32*)&(p->payload[0]);
-
- tmp[0] = (StgInt32)((StgInt64)i >> 32);
- tmp[1] = (StgInt32)i; /* truncate high 32 bits */
-
- return p;
-}
-
-#else
-
HaskellObj
rts_mkInt64 (Capability *cap, HsInt64 i)
{
- llong *tmp;
StgClosure *p = (StgClosure *)allocateLocal(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;
}
-#endif /* sparc_HOST_ARCH */
-
-
HaskellObj
rts_mkWord (Capability *cap, HsWord i)
{
HaskellObj
rts_mkWord64 (Capability *cap, HsWord64 w)
{
- ullong *tmp;
-
StgClosure *p = (StgClosure *)allocateLocal(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)
{
return (HsInt32)(HsInt)(UNTAG_CLOSURE(p)->payload[0]);
}
-
-#ifdef sparc_HOST_ARCH
-/* The closures returned by allocateLocal are only guaranteed to be 32 bit
- aligned, because that's the size of pointers. SPARC v9 can't do
- misaligned loads/stores, so we have to read the 64bit word in chunks */
-
-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;
-}
-
-#else
-
HsInt64
rts_getInt64 (HaskellObj p)
{
- HsInt32* tmp;
// See comment above:
// ASSERT(p->header.info == I64zh_con_info ||
// p->header.info == I64zh_static_info);
- tmp = (HsInt32*)&(UNTAG_CLOSURE(p)->payload[0]);
-
- HsInt64 i = (HsInt64)(tmp[0] << 32) | (HsInt64)tmp[1];
- return i
+ return PK_Int64((P_)&(UNTAG_CLOSURE(p)->payload[0]));
}
-#endif /* sparc_HOST_ARCH */
-
-
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);