static void printStack( StgStack *stack )
{
printStackChunk( stack->sp, stack->stack + stack->stack_size );
}
void printTSO( StgTSO *tso )
{
printStackChunk( tso->stackobj->sp,
tso->stackobj->stack+tso->stackobj->stack_size);
}
Capability *
interpretBCO (Capability* cap)
{
// Use of register here is primarily to make it clear to compilers
// that these entities are non-aliasable.
register StgPtr Sp; // local state -- stack pointer
register StgPtr SpLim; // local state -- stack lim pointer
register StgClosure *tagged_obj = 0, *obj;
nat n, m;
LOAD_STACK_POINTERS;
cap->r.rHpLim = (P_)1; // HpLim is the context-switch flag; when it
// goes to zero we must return to the scheduler.
// ------------------------------------------------------------------------
// Case 1:
//
// We have a closure to evaluate. Stack looks like:
//
// | XXXX_info |
// +---------------+
// Sp | -------------------> closure
// +---------------+
//
if (Sp[0] == (W_)&stg_enter_info) {
Sp++;
goto eval;
}
// ------------------------------------------------------------------------
// Case 2:
//
// We have a BCO application to perform. Stack looks like:
//
// | .... |
// +---------------+
// | arg1 |
// +---------------+
// | BCO |
// +---------------+
// Sp | RET_BCO |
// +---------------+
//
else if (Sp[0] == (W_)&stg_apply_interp_info) {
obj = UNTAG_CLOSURE((StgClosure *)Sp[1]);
Sp += 2;
goto run_BCO_fun;
}
// ------------------------------------------------------------------------
// Case 3:
//
// We have an unboxed value to return. See comment before
// do_return_unboxed, below.
//
else {
goto do_return_unboxed;
}
// Evaluate the object on top of the stack.
eval:
tagged_obj = (StgClosure*)Sp[0]; Sp++;
eval_obj:
obj = UNTAG_CLOSURE(tagged_obj);
INTERP_TICK(it_total_evals);
IF_DEBUG(interpreter,
debugBelch(
"\n---------------------------------------------------------------\n");
debugBelch("Evaluating: "); printObj(obj);
debugBelch("Sp = %p\n", Sp);
debugBelch("\n" );
printStackChunk(Sp,cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size);
debugBelch("\n\n");
);
