From 23e5985c3db852981d527d10d6a6271688049790 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Wed, 13 Jun 2007 10:29:28 +0000 Subject: [PATCH] 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. --- compiler/cmm/CmmParse.y | 9 +++-- compiler/codeGen/CgInfoTbls.hs | 6 ++- includes/InfoTables.h | 83 +++++++++++++++++++++++++--------------- rts/Printer.c | 4 +- rts/ProfHeap.c | 10 +++-- rts/RetainerProfile.c | 6 +-- rts/RetainerSet.c | 6 +-- 7 files changed, 76 insertions(+), 48 deletions(-) diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index ae23e19..b3f68a9 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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); } } -- 1.7.10.4