X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FInterpreter.c;h=6e70de845db29bca4d3e2f0ab1075aee6a50899f;hb=1d026619ef5f098a0349ba2fa1b29d5697718bad;hp=00830f43f2c4336462497ba79056c38b464a9a7f;hpb=2777940384ce4740954062bedd0f6813698fc72a;p=ghc-hetmet.git

diff --git a/rts/Interpreter.c b/rts/Interpreter.c
index 00830f4..6e70de8 100644
--- a/rts/Interpreter.c
+++ b/rts/Interpreter.c
@@ -847,15 +847,20 @@ run_BCO:
                   // 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 -= 9;
+                  Sp[8] = (W_)obj;   
+                  Sp[7] = (W_)&stg_apply_interp_info;
+                  Sp[6] = (W_)&stg_noforceIO_info;     // see [unreg] below
                   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
+                  // Note [unreg]: in unregisterised mode, the return
+                  // convention for IO is different.  The
+                  // stg_noForceIO_info stack frame is necessary to
+                  // account for this difference.
 
                   // set the flag in the TSO to say that we are now
                   // stopping at a breakpoint so that when we resume
@@ -1329,9 +1334,14 @@ run_BCO:
 	    // on the stack frame to describe this chunk of stack.
 	    //
 	    Sp -= ret_dyn_size;
-	    ((StgRetDyn *)Sp)->liveness = NO_PTRS | N_NONPTRS(stk_offset);
+	    ((StgRetDyn *)Sp)->liveness = R1_PTR | N_NONPTRS(stk_offset);
 	    ((StgRetDyn *)Sp)->info = (StgInfoTable *)&stg_gc_gen_info;
 
+            // save obj (pointer to the current BCO), since this
+            // might move during the call.  We use the R1 slot in the
+            // RET_DYN frame for this, hence R1_PTR above.
+            ((StgRetDyn *)Sp)->payload[0] = (StgClosure *)obj;
+
 	    SAVE_STACK_POINTERS;
 	    tok = suspendThread(&cap->r);
 
@@ -1352,6 +1362,16 @@ run_BCO:
 	    // And restart the thread again, popping the RET_DYN frame.
 	    cap = (Capability *)((void *)((unsigned char*)resumeThread(tok) - sizeof(StgFunTable)));
 	    LOAD_STACK_POINTERS;
+
+            // 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.
+            obj        = ((StgRetDyn *)Sp)->payload[0];
+            bco        = (StgBCO*)obj;
+            instrs     = (StgWord16*)(bco->instrs->payload);
+            literals   = (StgWord*)(&bco->literals->payload[0]);
+            ptrs       = (StgPtr*)(&bco->ptrs->payload[0]);
+
 	    Sp += ret_dyn_size;
 	    
 	    // Save the Haskell thread's current value of errno