caf.diff

From 8016ef549062e6622a6acece5499501999c58994 Mon Sep 17 00:00:00 2001
From: Arash Rouhani <[email protected]>
Date: Mon, 13 Jan 2014 14:53:53 +0100
Subject: [PATCH] Make CAFs backtraceable for stack tracing

Before:
  0: stg_bh_upd_frame_ret (at rts/Updates.cmm:86:1-91:2)
  1: crashSelf (at my/Main.hs:23:15-23:40)
  2: + (at libraries/base/GHC/Num.lhs:86:19-86:30)
  3: crashSelf (at my/Main.hs:23:15-23:40)
  4: + (at libraries/base/GHC/Num.lhs:86:19-86:30)

After:
  0: divZeroError (at libraries/base/GHC/Real.lhs:55:1-55:39)
  1: crashSelf (at my/Main.hs:23:15-23:40)
  2: + (at libraries/base/GHC/Num.lhs:86:19-86:30)
  3: crashSelf (at my/Main.hs:23:15-23:40)
  4: + (at libraries/base/GHC/Num.lhs:86:19-86:30)
---
 includes/rts/storage/Closures.h |  6 ++++++
 includes/rts/storage/GC.h       |  4 ++--
 rts/Stack.c                     |  4 ++--
 rts/StgMiscClosures.cmm         |  2 +-
 rts/sm/Storage.c                | 15 ++++++++-------
 5 files changed, 19 insertions(+), 12 deletions(-)

diff --git a/includes/rts/storage/Closures.h b/includes/rts/storage/Closures.h
index 2704128..a161c1a 100644
--- a/includes/rts/storage/Closures.h
+++ b/includes/rts/storage/Closures.h
@@ -121,6 +121,12 @@ typedef struct {
 } StgInd;
 
 typedef struct {
+    StgHeader   header;
+    StgClosure *indirectee;
+    const StgInfoTable *original_code; //Arash: For stack tracing
+} StgBhInd;
+
+typedef struct {
     StgHeader     header;
     StgClosure   *indirectee;
     StgClosure   *static_link;
diff --git a/includes/rts/storage/GC.h b/includes/rts/storage/GC.h
index e4943e6..2901d31 100644
--- a/includes/rts/storage/GC.h
+++ b/includes/rts/storage/GC.h
@@ -180,8 +180,8 @@ void performMajorGC(void);
    The CAF table - used to let us revert CAFs in GHCi
    -------------------------------------------------------------------------- */
 
-StgInd *newCAF    (StgRegTable *reg, StgIndStatic *caf);
-StgInd *newDynCAF (StgRegTable *reg, StgIndStatic *caf);
+StgBhInd *newCAF    (StgRegTable *reg, StgIndStatic *caf);
+StgBhInd *newDynCAF (StgRegTable *reg, StgIndStatic *caf);
 void revertCAFs (void);
 
 // Request that all CAFs are retained indefinitely.
diff --git a/rts/Stack.c b/rts/Stack.c
index a4acd73..113ec5a 100644
--- a/rts/Stack.c
+++ b/rts/Stack.c
@@ -65,8 +65,8 @@ getExecuteableCode (StgClosure *p) {
         p = ((StgUpdateFrame*)p)->updatee;
     }
     else if (p->header.info == &stg_bh_upd_frame_info) {
-        /* p = ((StgUpdateFrame*)p)->updatee; */
-        /* return (StgFunPtr)(p->payload[1]); */
+        p = ((StgUpdateFrame*)p)->updatee;
+        return ((StgBhInd*)(p))->original_code;
     }
 #if defined(TABLES_NEXT_TO_CODE)
     return *(StgFunPtr *)p;
diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm
index dc488f3..3f56372 100644
--- a/rts/StgMiscClosures.cmm
+++ b/rts/StgMiscClosures.cmm
@@ -365,7 +365,7 @@ INFO_TABLE(__stg_EAGER_BLACKHOLE,1,0,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
 // evaluation, and one that points to a closure that is under
 // evaluation by another thread (a BLACKHOLE).  See threadPaused().
 //
-INFO_TABLE(stg_CAF_BLACKHOLE,1,0,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
+INFO_TABLE(stg_CAF_BLACKHOLE,1,1,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
     (P_ node)
 {
     jump ENTRY_LBL(stg_BLACKHOLE) (node);
diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 9c3f832..0f1ba7e 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -337,12 +337,12 @@ freeStorage (rtsBool free_heap)
 
    -------------------------------------------------------------------------- */
 
-STATIC_INLINE StgInd *
+STATIC_INLINE StgBhInd *
 lockCAF (StgRegTable *reg, StgIndStatic *caf)
 {
     const StgInfoTable *orig_info;
     Capability *cap = regTableToCapability(reg);
-    StgInd *bh;
+    StgBhInd *bh;
 
     orig_info = caf->header.info;
 
@@ -372,9 +372,10 @@ lockCAF (StgRegTable *reg, StgIndStatic *caf)
     caf->saved_info = orig_info;
 
     // Allocate the blackhole indirection closure
-    bh = (StgInd *)allocate(cap, sizeofW(*bh));
+    bh = (StgBhInd *)allocate(cap, sizeofW(*bh));
     SET_HDR(bh, &stg_CAF_BLACKHOLE_info, caf->header.prof.ccs);
     bh->indirectee = (StgClosure *)cap->r.rCurrentTSO;
+    bh->original_code = orig_info;
 
     caf->indirectee = (StgClosure *)bh;
     write_barrier();
@@ -383,10 +384,10 @@ lockCAF (StgRegTable *reg, StgIndStatic *caf)
     return bh;
 }
 
-StgInd *
+StgBhInd *
 newCAF(StgRegTable *reg, StgIndStatic *caf)
 {
-    StgInd *bh;
+    StgBhInd *bh;
 
     bh = lockCAF(reg, caf);
     if (!bh) return NULL;
@@ -452,10 +453,10 @@ setKeepCAFs (void)
 //
 // The linker hackily arranges that references to newCaf from dynamic
 // code end up pointing to newDynCAF.
-StgInd *
+StgBhInd *
 newDynCAF (StgRegTable *reg, StgIndStatic *caf)
 {
-    StgInd *bh;
+    StgBhInd *bh;
 
     bh = lockCAF(reg, caf);
     if (!bh) return NULL;
-- 
1.8.3.2