X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FInterpreter.c;h=527ebde0d01211da37a2b8e1a5541dbbffb0d979;hb=6494b3cb78498363a2578a62d6cbbf3f55793e2a;hp=188693ccb6d9436105c34d29076a391164d6005c;hpb=cdce647711c0f46f5799b24de087622cb77e647f;p=ghc-hetmet.git diff --git a/rts/Interpreter.c b/rts/Interpreter.c index 188693c..527ebde 100644 --- a/rts/Interpreter.c +++ b/rts/Interpreter.c @@ -16,6 +16,7 @@ #include "Updates.h" #include "Sanity.h" #include "Liveness.h" +#include "Prelude.h" #include "Bytecodes.h" #include "Printer.h" @@ -83,7 +84,8 @@ allocate_NONUPD (int n_words) 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 @@ -177,7 +179,7 @@ static StgWord app_ptrs_itbl[] = { (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 * @@ -222,7 +224,7 @@ interpretBCO (Capability* cap) // +---------------+ // 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; } @@ -242,6 +244,7 @@ eval: obj = (StgClosure*)Sp[0]; Sp++; eval_obj: + obj = UNTAG_CLOSURE(obj); INTERP_TICK(it_total_evals); IF_DEBUG(interpreter, @@ -325,7 +328,7 @@ eval_obj: 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; } @@ -529,7 +532,7 @@ do_apply: 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; } @@ -554,7 +557,7 @@ do_apply: 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) { @@ -562,7 +565,7 @@ do_apply: 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 */ { @@ -786,73 +789,83 @@ run_BCO: { 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); } } @@ -1365,32 +1378,3 @@ run_BCO: 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; -}