Re-working of the breakpoint support

This is the result of Bernie Pope's internship work at MSR Cambridge,
with some subsequent improvements by me.  The main plan was to

 (a) Reduce the overhead for breakpoints, so we could enable 
     the feature by default without incurrent a significant penalty
 (b) Scatter more breakpoint sites throughout the code

Currently we can set a breakpoint on almost any subexpression, and the
overhead is around 1.5x slower than normal GHCi.  I hope to be able to
get this down further and/or allow breakpoints to be turned off.

This patch also fixes up :print following the recent changes to
constructor info tables.  (most of the :print tests now pass)

We now support single-stepping, which just enables all breakpoints.

  :step <expr>     executes <expr> with single-stepping turned on
  :step            single-steps from the current breakpoint

The mechanism is quite different to the previous implementation.  We
share code with the HPC (haskell program coverage) implementation now.
The coverage pass annotates source code with "tick" locations which
are tracked by the coverage tool.  In GHCi, each "tick" becomes a
potential breakpoint location.

Previously breakpoints were compiled into code that magically invoked
a nested instance of GHCi.  Now, a breakpoint causes the current
thread to block and control is returned to GHCi.

See the wiki page for more details and the current ToDo list:

  http://hackage.haskell.org/trac/ghc/wiki/NewGhciDebugger

1 files changed, 46 insertions, 20 deletions

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 31f58d1f12..bb9faddef5 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1823,6 +1823,7 @@ newBCOzh_fast
     W_ bco, bitmap_arr, bytes, words;
     
     bitmap_arr = R5;
+
     words = BYTES_TO_WDS(SIZEOF_StgBCO) + StgArrWords_words(bitmap_arr);
     bytes = WDS(words);
 
@@ -1876,34 +1877,48 @@ mkApUpd0zh_fast
     RET_P(ap);
 }
 
-infoPtrzh_fast
-{
-/* args: R1 = closure to analyze */
-   
-  MAYBE_GC(R1_PTR, infoPtrzh_fast);
-
-  W_ info;
-  info = %GET_STD_INFO(R1);
-  RET_N(info);
-}
-
-closurePayloadzh_fast
+unpackClosurezh_fast
 {
 /* args: R1 = closure to analyze */
 // TODO: Consider the absence of ptrs or nonptrs as a special case ?
 
-    MAYBE_GC(R1_PTR, closurePayloadzh_fast);
-
     W_ info, ptrs, nptrs, p, ptrs_arr, nptrs_arr;
     info  = %GET_STD_INFO(R1);
     ptrs  = TO_W_(%INFO_PTRS(info)); 
     nptrs = TO_W_(%INFO_NPTRS(info));
-    p = 0;
 
-    ALLOC_PRIM (SIZEOF_StgMutArrPtrs + WDS(ptrs), R1_PTR, closurePayloadzh_fast);
-    ptrs_arr = Hp - SIZEOF_StgMutArrPtrs - WDS(ptrs) + WDS(1);
+    // Some closures have non-standard layout, so we omit those here.
+    W_ type;
+    type = TO_W_(%INFO_TYPE(info));
+    switch [0 .. N_CLOSURE_TYPES] type {
+    case THUNK_SELECTOR : {
+        ptrs = 1;
+        nptrs = 0;
+        goto out;
+    }
+    case THUNK, THUNK_1_0, THUNK_0_1, THUNK_2_0, THUNK_1_1, 
+         THUNK_0_2, THUNK_STATIC, AP, PAP, AP_STACK, BCO : {
+        ptrs = 0;
+        nptrs = 0;
+        goto out;
+    }
+    default: {
+        goto out;
+    }}
+out:
+
+    W_ ptrs_arr_sz, nptrs_arr_sz;
+    nptrs_arr_sz = SIZEOF_StgArrWords   + WDS(nptrs);
+    ptrs_arr_sz  = SIZEOF_StgMutArrPtrs + WDS(ptrs);
+
+    ALLOC_PRIM (ptrs_arr_sz + nptrs_arr_sz, R1_PTR, unpackClosurezh_fast);
+
+    ptrs_arr  = Hp - nptrs_arr_sz - ptrs_arr_sz + WDS(1);
+    nptrs_arr = Hp - nptrs_arr_sz + WDS(1);
+
     SET_HDR(ptrs_arr, stg_MUT_ARR_PTRS_FROZEN_info, W_[CCCS]);
     StgMutArrPtrs_ptrs(ptrs_arr) = ptrs;
+    p = 0;
 for:
     if(p < ptrs) {
     	 W_[ptrs_arr + SIZEOF_StgMutArrPtrs + WDS(p)] = StgClosure_payload(R1,p);
@@ -1911,8 +1926,6 @@ for:
 	 goto for;
     }
     
-    ALLOC_PRIM (SIZEOF_StgArrWords + WDS(nptrs), R1_PTR, closurePayloadzh_fast);
-    nptrs_arr = Hp - SIZEOF_StgArrWords - WDS(nptrs) + WDS(1);
     SET_HDR(nptrs_arr, stg_ARR_WORDS_info, W_[CCCS]);
     StgArrWords_words(nptrs_arr) = nptrs;
     p = 0;
@@ -1922,7 +1935,7 @@ for2:
     	 p = p + 1;
 	 goto for2;
     }
-    RET_PP(ptrs_arr, nptrs_arr);
+    RET_NPP(info, ptrs_arr, nptrs_arr);
 }
 
 /* -----------------------------------------------------------------------------
@@ -2149,3 +2162,16 @@ noDuplicatezh_fast
         jump %ENTRY_CODE(Sp(0));
     }
 }
+
+getApStackValzh_fast
+{
+   W_ ap_stack, offset, val;
+
+   /* args: R1 = tso, R2 = offset */
+   ap_stack = R1;
+   offset   = R2;
+
+   val = StgClosure_payload(ap_stack,offset); 
+
+   RET_P(val);
+}