#include "Updates.h"
#include "Sanity.h"
#include "Liveness.h"
+#include "Prelude.h"
#include "Bytecodes.h"
#include "Printer.h"
return allocate(stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
}
-rtsBool stop_next_breakpoint = rtsFalse;
+int rts_stop_next_breakpoint = 0;
+int rts_stop_on_exception = 0;
#ifdef INTERP_STATS
(W_)&stg_ap_pppppp_info,
};
-HsStablePtr breakPointIOAction; // points to the IO action which is executed on a breakpoint
+HsStablePtr rts_breakpoint_io_action; // points to the IO action which is executed on a breakpoint
// it is set in main/GHC.hs:runStmt
Capability *
// +---------------+
//
else if (Sp[0] == (W_)&stg_apply_interp_info) {
- obj = (StgClosure *)Sp[1];
+ obj = UNTAG_CLOSURE((StgClosure *)Sp[1]);
Sp += 2;
goto run_BCO_fun;
}
obj = (StgClosure*)Sp[0]; Sp++;
eval_obj:
+ obj = UNTAG_CLOSURE(obj);
INTERP_TICK(it_total_evals);
IF_DEBUG(interpreter,
Sp[i] = (W_)ap->payload[i];
}
- obj = (StgClosure*)ap->fun;
+ obj = UNTAG_CLOSURE((StgClosure*)ap->fun);
ASSERT(get_itbl(obj)->type == BCO);
goto run_BCO_fun;
}
pap = (StgPAP *)obj;
// we only cope with PAPs whose function is a BCO
- if (get_itbl(pap->fun)->type != BCO) {
+ if (get_itbl(UNTAG_CLOSURE(pap->fun))->type != BCO) {
goto defer_apply_to_sched;
}
for (i = 0; i < pap->n_args; i++) {
Sp[i] = (W_)pap->payload[i];
}
- obj = pap->fun;
+ obj = UNTAG_CLOSURE(pap->fun);
goto run_BCO_fun;
}
else if (arity == n) {
for (i = 0; i < pap->n_args; i++) {
Sp[i] = (W_)pap->payload[i];
}
- obj = pap->fun;
+ obj = UNTAG_CLOSURE(pap->fun);
goto run_BCO_fun;
}
else /* arity > n */ {
{
int arg1_brk_array, arg2_array_index, arg3_freeVars;
StgArrWords *breakPoints;
- int returning_from_break; /* are we resuming execution from a breakpoint?
- ** if yes, then don't break this time around */
+ int returning_from_break; // are we resuming execution from a breakpoint?
+ // if yes, then don't break this time around
StgClosure *ioAction; // the io action to run at a breakpoint
StgAP_STACK *new_aps; // a closure to save the top stack frame on the heap
int i;
int size_words;
- arg1_brk_array = BCO_NEXT; /* first argument of break instruction */
- arg2_array_index = BCO_NEXT; /* second dargument of break instruction */
- arg3_freeVars = BCO_NEXT; /* third argument of break instruction */
+ arg1_brk_array = BCO_NEXT; // 1st arg of break instruction
+ arg2_array_index = BCO_NEXT; // 2nd arg of break instruction
+ arg3_freeVars = BCO_NEXT; // 3rd arg of break instruction
- // check if we are returning from a breakpoint - this info is stored in
- // the flags field of the current TSO
+ // check if we are returning from a breakpoint - this info
+ // is stored in the flags field of the current TSO
returning_from_break = cap->r.rCurrentTSO->flags & TSO_STOPPED_ON_BREAKPOINT;
- // if we are returning from a break then skip this section and continue executing
+ // if we are returning from a break then skip this section
+ // and continue executing
if (!returning_from_break)
{
breakPoints = (StgArrWords *) BCO_PTR(arg1_brk_array);
- // stop the current thread if either the "stop_next_breakpoint" flag is true
- // OR if the breakpoint flag for this particular expression is true
- if (stop_next_breakpoint == rtsTrue || breakPoints->payload[arg2_array_index] == rtsTrue)
+ // stop the current thread if either the
+ // "rts_stop_next_breakpoint" flag is true OR if the
+ // breakpoint flag for this particular expression is
+ // true
+ if (rts_stop_next_breakpoint == rtsTrue ||
+ breakPoints->payload[arg2_array_index] == rtsTrue)
{
- stop_next_breakpoint = rtsFalse; // make sure we don't automatically stop at the next breakpoint
-
- // allocate memory for a new AP_STACK, enough to store the top stack frame
- // plus an stg_apply_interp_info pointer and a pointer to the BCO
+ // make sure we don't automatically stop at the
+ // next breakpoint
+ rts_stop_next_breakpoint = rtsFalse;
+
+ // allocate memory for a new AP_STACK, enough to
+ // store the top stack frame plus an
+ // stg_apply_interp_info pointer and a pointer to
+ // the BCO
size_words = BCO_BITMAP_SIZE(obj) + 2;
new_aps = (StgAP_STACK *) allocate (AP_STACK_sizeW(size_words));
SET_HDR(new_aps,&stg_AP_STACK_info,CCS_SYSTEM);
new_aps->size = size_words;
- // we should never enter new_aps->fun, so it is assigned to a dummy value
- // ToDo: fixme to something that explodes with an error if you enter it
new_aps->fun = &stg_dummy_ret_closure;
// fill in the payload of the AP_STACK
- new_aps->payload[0] = (W_)&stg_apply_interp_info;
- new_aps->payload[1] = (W_)obj;
+ new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
+ new_aps->payload[1] = (StgClosure *)obj;
// copy the contents of the top stack frame into the AP_STACK
for (i = 2; i < size_words; i++)
{
- new_aps->payload[i] = (W_)Sp[i-2];
+ new_aps->payload[i] = (StgClosure *)Sp[i-2];
}
- // prepare the stack so that we can call the breakPointIOAction
- // and ensure that the stack is in a reasonable state for the GC
- // and so that execution of this BCO can continue when we resume
- ioAction = (StgClosure *) deRefStablePtr (breakPointIOAction);
- Sp -= 7;
- Sp[6] = (W_)obj;
- Sp[5] = (W_)&stg_apply_interp_info;
- Sp[4] = (W_)new_aps; /* the AP_STACK */
- Sp[3] = (W_)BCO_PTR(arg3_freeVars); /* the info about local vars of the breakpoint */
- Sp[2] = (W_)&stg_ap_ppv_info;
- Sp[1] = (W_)ioAction; /* apply the IO action to its two arguments above */
- Sp[0] = (W_)&stg_enter_info; /* get ready to run the IO action */
-
- // set the flag in the TSO to say that we are now stopping at a breakpoint
- // so that when we resume we don't stop on the same breakpoint that we already
- // stopped at just now
+ // prepare the stack so that we can call the
+ // rts_breakpoint_io_action and ensure that the stack is
+ // in a reasonable state for the GC and so that
+ // execution of this BCO can continue when we resume
+ ioAction = (StgClosure *) deRefStablePtr (rts_breakpoint_io_action);
+ Sp -= 8;
+ Sp[7] = (W_)obj;
+ Sp[6] = (W_)&stg_apply_interp_info;
+ Sp[5] = (W_)new_aps; // the AP_STACK
+ Sp[4] = (W_)BCO_PTR(arg3_freeVars); // the info about local vars of the breakpoint
+ Sp[3] = (W_)False_closure; // True <=> a breakpoint
+ Sp[2] = (W_)&stg_ap_pppv_info;
+ Sp[1] = (W_)ioAction; // apply the IO action to its two arguments above
+ Sp[0] = (W_)&stg_enter_info; // get ready to run the IO action
+
+ // set the flag in the TSO to say that we are now
+ // stopping at a breakpoint so that when we resume
+ // we don't stop on the same breakpoint that we
+ // already stopped at just now
cap->r.rCurrentTSO->flags |= TSO_STOPPED_ON_BREAKPOINT;
- // stop this thread and return to the scheduler - eventually we will come back
- // and the IO action on the top of the stack will be executed
+ // stop this thread and return to the scheduler -
+ // eventually we will come back and the IO action on
+ // the top of the stack will be executed
RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
}
}
barf("interpretBCO: fell off end of the interpreter");
}
-
-/* temporary code for peeking inside a AP_STACK and pulling out values
- based on their stack offset - used in the debugger for inspecting
- the local values of a breakpoint
-*/
-HsStablePtr rts_getApStackVal (HsStablePtr, int);
-HsStablePtr rts_getApStackVal (HsStablePtr apStackSptr, int offset)
-{
- HsStablePtr resultSptr;
- StgAP_STACK *apStack;
- StgClosure **payload;
- StgClosure *val;
-
- apStack = (StgAP_STACK *) deRefStablePtr (apStackSptr);
- payload = apStack->payload;
- val = (StgClosure *) payload[offset+2];
- resultSptr = getStablePtr (val);
- return resultSptr;
-}
-
-/* set the single step flag for the debugger to True -
- it gets set back to false in the interpreter everytime
- we hit a breakpoint
-*/
-void rts_setStepFlag (void);
-void rts_setStepFlag (void)
-{
- stop_next_breakpoint = rtsTrue;
-}
projects / ghc-hetmet.git / blobdiff