#define RETURN_TO_SCHEDULER(todo,retcode) \
SAVE_STACK_POINTERS; \
cap->r.rCurrentTSO->what_next = (todo); \
- threadPaused(cap->r.rCurrentTSO); \
- return (retcode);
+ threadPaused(cap,cap->r.rCurrentTSO); \
+ cap->r.rRet = (retcode); \
+ return cap;
#define RETURN_TO_SCHEDULER_NO_PAUSE(todo,retcode) \
- SAVE_STACK_POINTERS; \
- cap->r.rCurrentTSO->what_next = (todo); \
- return (retcode);
-
+ SAVE_STACK_POINTERS; \
+ cap->r.rCurrentTSO->what_next = (todo); \
+ cap->r.rRet = (retcode); \
+ return cap;
-STATIC_INLINE StgPtr
-allocate_UPD (int n_words)
-{
- return allocate(stg_max(sizeofW(StgHeader)+MIN_UPD_SIZE, n_words));
-}
STATIC_INLINE StgPtr
allocate_NONUPD (int n_words)
{
- return allocate(stg_max(sizeofW(StgHeader)+MIN_NONUPD_SIZE, n_words));
+ return allocate(stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
}
(W_)&stg_ap_pppppp_info,
};
-StgThreadReturnCode
+Capability *
interpretBCO (Capability* cap)
{
// Use of register here is primarily to make it clear to compilers
else /* arity > n */ {
// build a new PAP and return it.
StgPAP *new_pap;
- nat size;
- size = PAP_sizeW(pap->n_args + m);
- new_pap = (StgPAP *)allocate(size);
+ new_pap = (StgPAP *)allocate(PAP_sizeW(pap->n_args + m));
SET_HDR(new_pap,&stg_PAP_info,CCCS);
new_pap->arity = pap->arity - n;
new_pap->n_args = pap->n_args + m;
else /* arity > n */ {
// build a PAP and return it.
StgPAP *pap;
- nat size, i;
- size = PAP_sizeW(m);
- pap = (StgPAP *)allocate(size);
+ nat i;
+ pap = (StgPAP *)allocate(PAP_sizeW(m));
SET_HDR(pap, &stg_PAP_info,CCCS);
pap->arity = arity - n;
pap->fun = obj;
case bci_ALLOC_AP: {
StgAP* ap;
int n_payload = BCO_NEXT;
- int request = PAP_sizeW(n_payload);
- ap = (StgAP*)allocate_UPD(request);
+ ap = (StgAP*)allocate(AP_sizeW(n_payload));
Sp[-1] = (W_)ap;
ap->n_args = n_payload;
SET_HDR(ap, &stg_AP_info, CCS_SYSTEM/*ToDo*/)
StgPAP* pap;
int arity = BCO_NEXT;
int n_payload = BCO_NEXT;
- int request = PAP_sizeW(n_payload);
- pap = (StgPAP*)allocate_NONUPD(request);
+ pap = (StgPAP*)allocate(PAP_sizeW(n_payload));
Sp[-1] = (W_)pap;
pap->n_args = n_payload;
pap->arity = arity;
StgAP* ap = (StgAP*)Sp[stkoff];
ASSERT((int)ap->n_args == n_payload);
ap->fun = (StgClosure*)Sp[0];
-
+
// The function should be a BCO, and its bitmap should
// cover the payload of the AP correctly.
ASSERT(get_itbl(ap->fun)->type == BCO
- && (get_itbl(ap)->type == PAP ||
- BCO_BITMAP_SIZE(ap->fun) == ap->n_args));
-
+ && BCO_BITMAP_SIZE(ap->fun) == ap->n_args);
+
for (i = 0; i < n_payload; i++)
ap->payload[i] = (StgClosure*)Sp[i+1];
Sp += n_payload+1;
goto nextInsn;
}
+ case bci_MKPAP: {
+ int i;
+ int stkoff = BCO_NEXT;
+ int n_payload = BCO_NEXT;
+ StgPAP* pap = (StgPAP*)Sp[stkoff];
+ ASSERT((int)pap->n_args == n_payload);
+ pap->fun = (StgClosure*)Sp[0];
+
+ // The function should be a BCO
+ ASSERT(get_itbl(pap->fun)->type == BCO);
+
+ for (i = 0; i < n_payload; i++)
+ pap->payload[i] = (StgClosure*)Sp[i+1];
+ Sp += n_payload+1;
+ IF_DEBUG(interpreter,
+ debugBelch("\tBuilt ");
+ printObj((StgClosure*)pap);
+ );
+ goto nextInsn;
+ }
+
case bci_UNPACK: {
/* Unpack N ptr words from t.o.s constructor */
int i;
}
case bci_CCALL: {
- StgInt tok;
+ void *tok;
int stk_offset = BCO_NEXT;
int o_itbl = BCO_NEXT;
void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl);
RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE
+ sizeofW(StgRetDyn);
-#ifdef RTS_SUPPORTS_THREADS
+#ifdef THREADED_RTS
// Threaded RTS:
// Arguments on the TSO stack are not good, because garbage
// collection might move the TSO as soon as we call
SAVE_STACK_POINTERS;
tok = suspendThread(&cap->r);
-#ifndef RTS_SUPPORTS_THREADS
+#ifndef THREADED_RTS
// Careful:
// suspendThread might have shifted the stack
// around (stack squeezing), so we have to grab the real
// Save the Haskell thread's current value of errno
cap->r.rCurrentTSO->saved_errno = errno;
-#ifdef RTS_SUPPORTS_THREADS
+#ifdef THREADED_RTS
// Threaded RTS:
// Copy the "arguments", which might include a return value,
// back to the TSO stack. It would of course be enough to