#define BCO_LIT(n) literals[n]
#define LOAD_STACK_POINTERS \
- Sp = cap->r.rCurrentTSO->sp; \
+ Sp = cap->r.rCurrentTSO->stackobj->sp; \
/* We don't change this ... */ \
- SpLim = cap->r.rCurrentTSO->stack + RESERVED_STACK_WORDS;
+ SpLim = tso_SpLim(cap->r.rCurrentTSO);
#define SAVE_STACK_POINTERS \
ASSERT(Sp > SpLim); \
- cap->r.rCurrentTSO->sp = Sp
+ cap->r.rCurrentTSO->stackobj->sp = Sp
#define RETURN_TO_SCHEDULER(todo,retcode) \
SAVE_STACK_POINTERS; \
debugBelch("Sp = %p\n", Sp);
debugBelch("\n" );
- printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
+ printStackChunk(Sp,cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size);
debugBelch("\n\n");
);
debugBelch("Returning: "); printObj(obj);
debugBelch("Sp = %p\n", Sp);
debugBelch("\n" );
- printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
+ printStackChunk(Sp,cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size);
debugBelch("\n\n");
);
- IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
+ IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size));
switch (get_itbl((StgClosure *)Sp)->type) {
INTERP_TICK(it_retto_other);
IF_DEBUG(interpreter,
debugBelch("returning to unknown frame -- yielding to sched\n");
- printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
+ printStackChunk(Sp,cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size);
);
Sp -= 2;
Sp[1] = (W_)tagged_obj;
INTERP_TICK(it_retto_other);
IF_DEBUG(interpreter,
debugBelch("returning to unknown frame -- yielding to sched\n");
- printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
- );
+ printStackChunk(Sp,cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size);
+ );
RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
}
}
void *tok;
int stk_offset = BCO_NEXT;
int o_itbl = BCO_NEXT;
+ int interruptible = BCO_NEXT;
void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl);
int ret_dyn_size =
RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE
((StgRetDyn *)Sp)->payload[0] = (StgClosure *)obj;
SAVE_STACK_POINTERS;
- tok = suspendThread(&cap->r);
+ tok = suspendThread(&cap->r, interruptible ? rtsTrue : rtsFalse);
// We already made a copy of the arguments above.
ffi_call(cif, fn, ret, argptrs);
cap = (Capability *)((void *)((unsigned char*)resumeThread(tok) - STG_FIELD_OFFSET(Capability,r)));
LOAD_STACK_POINTERS;
+ if (Sp[0] != (W_)&stg_gc_gen_info) {
+ // the stack is not how we left it. This probably
+ // means that an exception got raised on exit from the
+ // foreign call, so we should just continue with
+ // whatever is on top of the stack now.
+ RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
+ }
+
// Re-load the pointer to the BCO from the RET_DYN frame,
// it might have moved during the call. Also reload the
// pointers to the components of the BCO.