X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FInterpreter.c;h=527ebde0d01211da37a2b8e1a5541dbbffb0d979;hb=7fc749a43b4b6b85d234fa95d4928648259584f4;hp=c40d8946132ac4707348fa71d9b3d6cff9cf939a;hpb=61caf48a5f848cdd24e36a35645bc13c161df7a3;p=ghc-hetmet.git

diff --git a/rts/Interpreter.c b/rts/Interpreter.c
index c40d894..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 */ {
@@ -809,15 +812,15 @@ run_BCO:
                breakPoints = (StgArrWords *) BCO_PTR(arg1_brk_array);
 
                // stop the current thread if either the
-               // "stop_next_breakpoint" flag is true OR if the
+               // "rts_stop_next_breakpoint" flag is true OR if the
                // breakpoint flag for this particular expression is
                // true
-               if (stop_next_breakpoint == rtsTrue || 
+               if (rts_stop_next_breakpoint == rtsTrue || 
                    breakPoints->payload[arg2_array_index] == rtsTrue)
                {
                   // make sure we don't automatically stop at the
                   // next breakpoint
-                  stop_next_breakpoint = rtsFalse;
+                  rts_stop_next_breakpoint = rtsFalse;
 
                   // allocate memory for a new AP_STACK, enough to
                   // store the top stack frame plus an
@@ -840,16 +843,17 @@ run_BCO:
                   }
 
                   // prepare the stack so that we can call the
-                  // breakPointIOAction and ensure that the stack is
+                  // 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 (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;
+                  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
 
@@ -1374,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 ((P_)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;
-}