Hi,
Pepe Iborra pointed out that my patch is not in the right format for gnu
patch command.
Sorry for inconvenience (I used "darcs what -u" instead of "darcs diff -u").
Here it is attached in the correct format.
Thanks,
Peter.
diff -rN -u old-ghc/compiler/main/InteractiveEval.hs new-ghc/compiler/main/InteractiveEval.hs
--- old-ghc/compiler/main/InteractiveEval.hs 2009-04-14 11:51:34.768662881 +0200
+++ new-ghc/compiler/main/InteractiveEval.hs 2009-04-14 11:51:35.135331181 +0200
@@ -345,7 +345,7 @@
-- this points to the IO action that is executed when a breakpoint is hit
foreign import ccall "&rts_breakpoint_io_action"
- breakPointIOAction :: Ptr (StablePtr (Bool -> BreakInfo -> HValue -> IO ()))
+ breakPointIOAction :: Ptr (StablePtr (Bool -> BreakInfo -> HValue -> Int -> IO ()))
-- When running a computation, we redirect ^C exceptions to the running
-- thread. ToDo: we might want a way to continue even if the target
@@ -413,7 +413,7 @@
-- might be a bit surprising. The exception flag is turned off
-- as soon as it is hit, or in resetBreakAction below.
- onBreak is_exception info apStack = do
+ onBreak is_exception info apStack _ = do
tid <- myThreadId
putMVar statusMVar (Break is_exception apStack info tid)
takeMVar breakMVar
@@ -424,12 +424,12 @@
resetStepFlag
freeStablePtr stablePtr
-noBreakStablePtr :: StablePtr (Bool -> BreakInfo -> HValue -> IO ())
+noBreakStablePtr :: StablePtr (Bool -> BreakInfo -> HValue -> Int -> IO ())
noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
-noBreakAction :: Bool -> BreakInfo -> HValue -> IO ()
-noBreakAction False _ _ = putStrLn "*** Ignoring breakpoint"
-noBreakAction True _ _ = return () -- exception: just continue
+noBreakAction :: Bool -> BreakInfo -> HValue -> Int -> IO ()
+noBreakAction False _ _ x = putStrLn $ "*** Ignoring breakpoint " ++ show x
+noBreakAction True _ _ _ = return () -- exception: just continue
resume :: GhcMonad m => (SrcSpan->Bool) -> SingleStep -> m RunResult
resume canLogSpan step
diff -rN -u old-ghc/includes/StgMiscClosures.h new-ghc/includes/StgMiscClosures.h
--- old-ghc/includes/StgMiscClosures.h 2009-04-14 11:51:34.971997946 +0200
+++ new-ghc/includes/StgMiscClosures.h 2009-04-14 11:51:35.358664627 +0200
@@ -377,6 +377,7 @@
RTS_RET_INFO(stg_ap_ppp_info);
RTS_RET_INFO(stg_ap_pppv_info);
RTS_RET_INFO(stg_ap_pppp_info);
+RTS_RET_INFO(stg_ap_ppppv_info);
RTS_RET_INFO(stg_ap_ppppp_info);
RTS_RET_INFO(stg_ap_pppppp_info);
diff -rN -u old-ghc/rts/Exception.cmm new-ghc/rts/Exception.cmm
--- old-ghc/rts/Exception.cmm 2009-04-14 11:51:34.878663864 +0200
+++ new-ghc/rts/Exception.cmm 2009-04-14 11:51:35.391997906 +0200
@@ -402,15 +402,16 @@
// be per-thread.
W_[rts_stop_on_exception] = 0;
("ptr" ioAction) = foreign "C" deRefStablePtr (W_[rts_breakpoint_io_action] "ptr") [];
- Sp = Sp - WDS(7);
- Sp(6) = exception;
- Sp(5) = stg_raise_ret_info;
- Sp(4) = stg_noforceIO_info; // required for unregisterised
+ Sp = Sp - WDS(8);
+ Sp(7) = exception;
+ Sp(6) = stg_raise_ret_info;
+ Sp(5) = stg_noforceIO_info; // required for unregisterised
+ Sp(4) = 0;
Sp(3) = exception; // the AP_STACK
Sp(2) = ghczmprim_GHCziBool_True_closure; // dummy breakpoint info
Sp(1) = ghczmprim_GHCziBool_True_closure; // True <=> a breakpoint
R1 = ioAction;
- jump RET_LBL(stg_ap_pppv);
+ jump RET_LBL(stg_ap_ppppv);
}
}
diff -rN -u old-ghc/rts/Interpreter.c new-ghc/rts/Interpreter.c
--- old-ghc/rts/Interpreter.c 2009-04-14 11:51:34.861997785 +0200
+++ new-ghc/rts/Interpreter.c 2009-04-14 11:51:35.395331066 +0200
@@ -815,14 +815,8 @@
case bci_BRK_FUN:
{
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
- 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; // 1st arg of break instruction
arg2_array_index = BCO_NEXT; // 2nd arg of break instruction
@@ -836,6 +830,7 @@
// and continue executing
if (!returning_from_break)
{
+ StgArrWords *breakPoints;
breakPoints = (StgArrWords *) BCO_PTR(arg1_brk_array);
// stop the current thread if either the
@@ -845,6 +840,12 @@
if (rts_stop_next_breakpoint == rtsTrue ||
breakPoints->payload[arg2_array_index] == rtsTrue)
{
+ 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
+ StgClosure *stackSize;
+ int size_words;
+ int i;
+
// make sure we don't automatically stop at the
// next breakpoint
rts_stop_next_breakpoint = rtsFalse;
@@ -869,19 +870,24 @@
new_aps->payload[i] = (StgClosure *)Sp[i-2];
}
+ stackSize = (StgClosure*) allocate(CONSTR_sizeW(0,1));
+ SET_HDR(stackSize, Izh_con_info, CCS_SYSTEM);
+ stackSize->payload[0] = (StgClosure *)(StgInt) 0;
+
// 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 -= 9;
- Sp[8] = (W_)obj;
- Sp[7] = (W_)&stg_apply_interp_info;
- Sp[6] = (W_)&stg_noforceIO_info; // see [unreg] below
+ Sp -= 10;
+ Sp[9] = (W_)obj;
+ Sp[8] = (W_)&stg_apply_interp_info;
+ Sp[7] = (W_)&stg_noforceIO_info; // see [unreg] below
+ Sp[6] = (W_)stackSize; // stack size just before the breakpoint hit
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[2] = (W_)&stg_ap_ppppv_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
diff -rN -u old-ghc/utils/genapply/GenApply.hs new-ghc/utils/genapply/GenApply.hs
--- old-ghc/utils/genapply/GenApply.hs 2009-04-14 11:51:34.935329549 +0200
+++ new-ghc/utils/genapply/GenApply.hs 2009-04-14 11:51:35.475331386 +0200
@@ -792,6 +792,7 @@
[P,P,P],
[P,P,P,V],
[P,P,P,P],
+ [P,P,P,P,V],
[P,P,P,P,P],
[P,P,P,P,P,P]
]
_______________________________________________
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
