FIX #1418 (partially)

When the con_desc field of an info table was made into a relative
reference, this had the side effect of making the profiling fields
(closure_desc and closure_type) also relative, but only when compiling
via C, and the heap profiler was still treating them as absolute,
leading to crashes when profiling with -hd or -hy.

This patch fixes up the story to be consistent: these fields really
should be relative (otherwise we couldn't make shared versions of the
profiling libraries), so I've made them relative and fixed up the RTS
to know about this.

diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index ae23e19..b3f68a9 100644 (file)
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -724,16 +724,19 @@ conInfo name ptrs nptrs srt_bitmap cl_type desc_str ty_str = do
   return (lbl, info1, [desc_field])
 
 basicInfo name layout srt_bitmap cl_type desc_str ty_str = do
+  let info_lbl = mkRtsInfoLabelFS name
   lit1 <- if opt_SccProfilingOn 
-                  then code $ mkStringCLit desc_str
+                  then code $ do lit <- mkStringCLit desc_str
+                                  return (makeRelativeRefTo info_lbl lit)
                   else return (mkIntCLit 0)
   lit2 <- if opt_SccProfilingOn 
-                  then code $ mkStringCLit ty_str
+                  then code $ do lit <- mkStringCLit ty_str
+                                  return (makeRelativeRefTo info_lbl lit)
                   else return (mkIntCLit 0)
   let info1 = mkStdInfoTable lit1 lit2 (fromIntegral cl_type) 
                        (fromIntegral srt_bitmap)
                        layout
-  return (mkRtsInfoLabelFS name, info1, [])
+  return (info_lbl, info1, [])
 
 funInfo name ptrs nptrs cl_type desc_str ty_str fun_type = do
   (label,info1,_) <- stdInfo name ptrs nptrs 0{-srt_bitmap-}

diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs
index e2e07f9..62a6db2 100644 (file)
--- a/compiler/codeGen/CgInfoTbls.hs
+++ b/compiler/codeGen/CgInfoTbls.hs
@@ -74,11 +74,13 @@ emitClosureCodeAndInfoTable :: ClosureInfo -> [LocalReg] -> CgStmts -> Code
 emitClosureCodeAndInfoTable cl_info args body
  = do  { ty_descr_lit <- 
                if opt_SccProfilingOn 
-                  then mkStringCLit (closureTypeDescr cl_info)
+                  then do lit <- mkStringCLit (closureTypeDescr cl_info)
+                           return (makeRelativeRefTo info_lbl lit)
                   else return (mkIntCLit 0)
        ; cl_descr_lit <- 
                if opt_SccProfilingOn 
-                  then mkStringCLit cl_descr_string
+                  then do lit <- mkStringCLit cl_descr_string
+                           return (makeRelativeRefTo info_lbl lit)
                   else return (mkIntCLit 0)
        ; let std_info = mkStdInfoTable ty_descr_lit cl_descr_lit 
                                        cl_type srt_len layout_lit

diff --git a/includes/InfoTables.h b/includes/InfoTables.h
index 3e556ef..a8e76b0 100644 (file)
--- a/includes/InfoTables.h
+++ b/includes/InfoTables.h
@@ -9,13 +9,48 @@
 #ifndef INFOTABLES_H
 #define INFOTABLES_H
 
+/* ----------------------------------------------------------------------------
+   Relative pointers
+
+   Several pointer fields in info tables are expressed as offsets
+   relative to the info pointer, so that we can generate
+   position-independent code.
+
+   Note [x86-64-relative]
+   There is a complication on the x86_64 platform, where pointeres are
+   64 bits, but the tools don't support 64-bit relative relocations.
+   However, the default memory model (small) ensures that all symbols
+   have values in the lower 2Gb of the address space, so offsets all
+   fit in 32 bits.  Hence we can use 32-bit offset fields.
+
+   When going via-C, the mangler arranges that we only generate
+   relative relocations between symbols in the same segment (the text
+   segment).  The NCG, however, puts things in the right sections and
+   uses 32-bit relative offsets instead.
+
+   Somewhere between binutils-2.16.1 and binutils-2.16.91.0.6,
+   support for 64-bit PC-relative relocations was added, so maybe this
+   hackery can go away sometime.
+   ------------------------------------------------------------------------- */
+
+#if x86_64_TARGET_ARCH
+#define OFFSET_FIELD(n) StgHalfInt n; StgHalfWord __pad_##n;
+#else   
+#define OFFSET_FIELD(n) StgInt n;
+#endif
+
 /* -----------------------------------------------------------------------------
    Profiling info
    -------------------------------------------------------------------------- */
 
 typedef struct {
+#ifndef TABLES_NEXT_TO_CODE
     char *closure_type;
     char *closure_desc;
+#else
+    OFFSET_FIELD(closure_type_off);
+    OFFSET_FIELD(closure_desc_off);
+#endif
 } StgProfInfo;
 
 /* -----------------------------------------------------------------------------
@@ -210,36 +245,6 @@ typedef struct StgLargeSRT_ {
 } StgLargeSRT;
 
 /* ----------------------------------------------------------------------------
-   Relative pointers
-
-   Several pointer fields in info tables are expressed as offsets
-   relative to the info pointer, so that we can generate
-   position-independent code.
-
-   Note [x86-64-relative]
-   There is a complication on the x86_64 platform, where pointeres are
-   64 bits, but the tools don't support 64-bit relative relocations.
-   However, the default memory model (small) ensures that all symbols
-   have values in the lower 2Gb of the address space, so offsets all
-   fit in 32 bits.  Hence we can use 32-bit offset fields.
-
-   When going via-C, the mangler arranges that we only generate
-   relative relocations between symbols in the same segment (the text
-   segment).  The NCG, however, puts things in the right sections and
-   uses 32-bit relative offsets instead.
-
-   Somewhere between binutils-2.16.1 and binutils-2.16.91.0.6,
-   support for 64-bit PC-relative relocations was added, so maybe this
-   hackery can go away sometime.
-   ------------------------------------------------------------------------- */
-
-#if x86_64_TARGET_ARCH
-#define OFFSET_FIELD(n) StgHalfInt n; StgHalfWord __pad_##n;
-#else   
-#define OFFSET_FIELD(n) StgInt n;
-#endif
-
-/* ----------------------------------------------------------------------------
    Info Tables
    ------------------------------------------------------------------------- */
 
@@ -398,8 +403,12 @@ typedef struct _StgConInfoTable {
     StgInfoTable i;
 #endif
 
+#ifndef TABLES_NEXT_TO_CODE
+    char *con_desc;
+#else
     OFFSET_FIELD(con_desc) // the name of the data constructor 
                            // as: Package:Module.Name
+#endif
 
 #if defined(TABLES_NEXT_TO_CODE)
     StgInfoTable i;
@@ -455,5 +464,17 @@ typedef struct _StgConInfoTable {
 #define GET_FUN_LARGE_BITMAP(info) ((StgLargeBitmap*) ((info)->f.b.bitmap))
 #endif
 
-
+/*
+ * GET_PROF_TYPE, GET_PROF_DESC
+ */
+#ifdef TABLES_NEXT_TO_CODE
+#define GET_PROF_TYPE(info) ((char *)((StgWord)((info)+1) + (info->prof.closure_type_off)))
+#else
+#define GET_PROF_TYPE(info) ((info)->prof.closure_type)
+#endif
+#ifdef TABLES_NEXT_TO_CODE
+#define GET_PROF_DESC(info) ((char *)((StgWord)((info)+1) + (info->prof.closure_desc_off)))
+#else
+#define GET_PROF_DESC(info) ((info)->prof.closure_desc)
+#endif
 #endif /* INFOTABLES_H */

diff --git a/rts/Printer.c b/rts/Printer.c
index b33d238..2a0346b 100644 (file)
--- a/rts/Printer.c
+++ b/rts/Printer.c
@@ -138,7 +138,7 @@ printClosure( StgClosure *obj )
             StgWord i, j;
 
 #ifdef PROFILING
-           debugBelch("%s(", info->prof.closure_desc);
+           debugBelch("%s(", GET_PROF_DESC(info));
            debugBelch("%s", obj->header.prof.ccs->cc->label);
 #else
             debugBelch("CONSTR(");
@@ -174,7 +174,7 @@ printClosure( StgClosure *obj )
     case THUNK_STATIC:
             /* ToDo: will this work for THUNK_STATIC too? */
 #ifdef PROFILING
-           printThunkObject((StgThunk *)obj,info->prof.closure_desc);
+            printThunkObject((StgThunk *)obj,GET_PROF_DESC(info));
 #else
             printThunkObject((StgThunk *)obj,"THUNK");
 #endif

diff --git a/rts/ProfHeap.c b/rts/ProfHeap.c
index e8966ec..ed5dc36 100644 (file)
--- a/rts/ProfHeap.c
+++ b/rts/ProfHeap.c
@@ -99,6 +99,7 @@ static void dumpCensus( Census *census );
    Closure Type Profiling;
    ------------------------------------------------------------------------- */
 
+#ifndef PROFILING
 static char *type_names[] = {
     "INVALID_OBJECT",
     "CONSTR",
@@ -173,6 +174,7 @@ static char *type_names[] = {
     "CATCH_STM_FRAME",
     "N_CLOSURE_TYPES"
   };
+#endif
 
 /* ----------------------------------------------------------------------------
  * Find the "closure identity", which is a unique pointer reresenting
@@ -190,9 +192,9 @@ closureIdentity( StgClosure *p )
     case HEAP_BY_MOD:
        return p->header.prof.ccs->cc->module;
     case HEAP_BY_DESCR:
-       return get_itbl(p)->prof.closure_desc;
+       return GET_PROF_DESC(get_itbl(p));
     case HEAP_BY_TYPE:
-       return get_itbl(p)->prof.closure_type;
+       return GET_PROF_TYPE(get_itbl(p));
     case HEAP_BY_RETAINER:
        // AFAIK, the only closures in the heap which might not have a
        // valid retainer set are DEAD_WEAK closures.
@@ -645,12 +647,12 @@ closureSatisfiesConstraints( StgClosure* p )
    }
 
    if (RtsFlags.ProfFlags.descrSelector) {
-       b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_desc,
+       b = strMatchesSelector( (GET_PROF_DESC(get_itbl((StgClosure *)p))),
                                 RtsFlags.ProfFlags.descrSelector );
        if (!b) return rtsFalse;
    }
    if (RtsFlags.ProfFlags.typeSelector) {
-       b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_type,
+       b = strMatchesSelector( (GET_PROF_TYPE(get_itbl((StgClosure *)p))),
                                 RtsFlags.ProfFlags.typeSelector );
        if (!b) return rtsFalse;
    }

diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index 4920e7d..9f29aca 100644 (file)
--- a/rts/RetainerProfile.c
+++ b/rts/RetainerProfile.c
@@ -2110,8 +2110,8 @@ sanityCheckHeapClosure( StgClosure *c )
 
     if ((((StgWord)RSET(c) & 1) ^ flip) != 0) {
        if (get_itbl(c)->type == CONSTR &&
-           !strcmp(get_itbl(c)->prof.closure_type, "DEAD_WEAK") &&
-           !strcmp(get_itbl(c)->prof.closure_desc, "DEAD_WEAK")) {
+           !strcmp(GET_PROF_TYPE(get_itbl(c)), "DEAD_WEAK") &&
+           !strcmp(GET_PROF_DESC(get_itbl(c)), "DEAD_WEAK")) {
            debugBelch("\tUnvisited dead weak pointer object found: c = %p\n", c);
            costArray[get_itbl(c)->type] += cost(c);
            sumOfNewCost += cost(c);
@@ -2119,7 +2119,7 @@ sanityCheckHeapClosure( StgClosure *c )
            debugBelch(
                    "Unvisited object: flip = %d, c = %p(%d, %s, %s), rs = %p\n",
                    flip, c, get_itbl(c)->type,
-                   get_itbl(c)->prof.closure_type, get_itbl(c)->prof.closure_desc,
+                   get_itbl(c)->prof.closure_type, GET_PROF_DESC(get_itbl(c)),
                    RSET(c));
     } else {
        // debugBelch("sanityCheckHeapClosure) S: flip = %d, c = %p(%d), rs = %p\n", flip, c, get_itbl(c)->type, RSET(c));

diff --git a/rts/RetainerSet.c b/rts/RetainerSet.c
index bfa0bc8..e1db615 100644 (file)
--- a/rts/RetainerSet.c
+++ b/rts/RetainerSet.c
@@ -239,7 +239,7 @@ traverseAllRetainerSet(void (*f)(RetainerSet *))
 void
 printRetainer(FILE *f, retainer itbl)
 {
-    fprintf(f, "%s[%s]", itbl->prof.closure_desc, itbl->prof.closure_type);
+    fprintf(f, "%s[%s]", GET_PROF_DESC(itbl), itbl->prof.closure_type);
 }
 #elif defined(RETAINER_SCHEME_CCS)
 // Retainer scheme 2: retainer = cost centre stack
@@ -283,7 +283,7 @@ printRetainerSetShort(FILE *f, RetainerSet *rs)
 
     for (j = 0; j < rs->num; j++) {
        if (j < rs->num - 1) {
-           strncpy(tmp + size, rs->element[j]->prof.closure_desc, MAX_RETAINER_SET_SPACE - size);
+           strncpy(tmp + size, GET_PROF_DESC(rs->element[j]), MAX_RETAINER_SET_SPACE - size);
            size = strlen(tmp);
            if (size == MAX_RETAINER_SET_SPACE)
                break;
@@ -293,7 +293,7 @@ printRetainerSetShort(FILE *f, RetainerSet *rs)
                break;
        }
        else {
-           strncpy(tmp + size, rs->element[j]->prof.closure_desc, MAX_RETAINER_SET_SPACE - size);
+           strncpy(tmp + size, GET_PROF_DESC(rs->element[j]), MAX_RETAINER_SET_SPACE - size);
            // size = strlen(tmp);
        }
     }