#define BCO_NEXT instrs[bciPtr++]
#define BCO_PTR(n) (W_)ptrs[n]
-#define BCO_LIT(n) (W_)literals[n]
+#define BCO_LIT(n) literals[n]
#define BCO_ITBL(n) itbls[n]
#define LOAD_STACK_POINTERS \
cap->r.rCurrentTSO->sp = Sp
#define RETURN_TO_SCHEDULER(todo,retcode) \
- SAVE_STACK_POINTERS; \
- cap->r.rCurrentTSO->what_next = (todo); \
- return (retcode);
+ SAVE_STACK_POINTERS; \
+ cap->r.rCurrentTSO->what_next = (todo); \
+ threadPaused(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); \
+ cap->r.rRet = (retcode); \
+ return cap;
STATIC_INLINE StgPtr
(W_)&stg_ap_pppppp_info,
};
-StgThreadReturnCode
+Capability *
interpretBCO (Capability* cap)
{
// Use of register here is primarily to make it clear to compilers
Sp -= 2;
Sp[1] = (W_)obj;
Sp[0] = (W_)&stg_enter_info;
- RETURN_TO_SCHEDULER(ThreadRunGHC, ThreadYielding);
+ RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
}
}
Sp -= 2;
Sp[1] = (W_)obj;
Sp[0] = (W_)&stg_enter_info;
- RETURN_TO_SCHEDULER(ThreadRunGHC, ThreadYielding);
+ RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
}
}
debugBelch("returning to unknown frame -- yielding to sched\n");
printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
);
- RETURN_TO_SCHEDULER(ThreadRunGHC, ThreadYielding);
+ RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
}
}
}
case PAP: {
StgPAP *pap;
- nat arity, i;
+ nat i, arity;
pap = (StgPAP *)obj;
// Shuffle the args for this function down, and put
// the appropriate info table in the gap.
for (i = 0; i < arity; i++) {
- Sp[i-1] = Sp[i];
+ Sp[(int)i-1] = Sp[i];
+ // ^^^^^ careful, i-1 might be negative, but i in unsigned
}
Sp[arity-1] = app_ptrs_itbl[n-arity-1];
Sp--;
// Shuffle the args for this function down, and put
// the appropriate info table in the gap.
for (i = 0; i < arity; i++) {
- Sp[i-1] = Sp[i];
+ Sp[(int)i-1] = Sp[i];
+ // ^^^^^ careful, i-1 might be negative, but i in unsigned
}
Sp[arity-1] = app_ptrs_itbl[n-arity-1];
Sp--;
Sp -= 2;
Sp[1] = (W_)obj;
Sp[0] = (W_)&stg_enter_info;
- RETURN_TO_SCHEDULER(ThreadRunGHC, ThreadYielding);
+ RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
}
// ------------------------------------------------------------------------
int n_words = BCO_NEXT;
Sp -= n_words;
for (i = 0; i < n_words; i++) {
- Sp[i] = BCO_LIT(o_lits+i);
+ Sp[i] = (W_)BCO_LIT(o_lits+i);
}
goto nextInsn;
}
}
case bci_TESTLT_P: {
- int discr = BCO_NEXT;
+ unsigned int discr = BCO_NEXT;
int failto = BCO_NEXT;
StgClosure* con = (StgClosure*)Sp[0];
if (GET_TAG(con) >= discr) {
}
case bci_TESTEQ_P: {
- int discr = BCO_NEXT;
+ unsigned int discr = BCO_NEXT;
int failto = BCO_NEXT;
StgClosure* con = (StgClosure*)Sp[0];
if (GET_TAG(con) != discr) {
}
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