Cheng Shao pushed to branch wip/symbolizer at Glasgow Haskell Compiler / GHC Commits: f38fcd9b by Cheng Shao at 2025-08-16T13:57:20+02:00 compiler: fix closure C type in SPT init code This patch fixes the closure C type in SPT init code to StgClosure, instead of the previously incorrect StgPtr. Having an incorrect C type makes SPT init code not compatible with other foreign stub generation logic, which may also emit their own extern declarations for the same closure symbols and thus will clash with the incorrect prototypes in SPT init code. - - - - - 107feea4 by Cheng Shao at 2025-08-16T13:57:20+02:00 rts: remove libbfd logic - - - - - fd415c7a by Cheng Shao at 2025-08-16T13:57:20+02:00 compiler/rts: add debug symbolizer - - - - - 18 changed files: - + compiler/GHC/Cmm/GenerateDebugSymbolStub.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - compiler/ghc.cabal.in - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Settings/Packages.hs - − m4/fp_bfd_support.m4 - rts/Printer.c - rts/Printer.h - rts/RtsStartup.c - rts/configure.ac - rts/include/Rts.h - rts/include/rts/Config.h - + rts/include/rts/Debug.h - rts/rts.cabal Changes: ===================================== compiler/GHC/Cmm/GenerateDebugSymbolStub.hs ===================================== @@ -0,0 +1,138 @@ +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE Strict #-} + +module GHC.Cmm.GenerateDebugSymbolStub + ( generateDebugSymbolStub, + ) +where + +import Control.Monad +import Control.Monad.IO.Class +import Data.Foldable +import Data.Functor +import Data.IORef +import Data.List (isSuffixOf) +import Data.Map.Strict qualified as Map +import Data.Maybe +import GHC.Cmm +import GHC.Cmm.CLabel +import GHC.Cmm.Dataflow.Label qualified as H +import GHC.Data.FastString +import GHC.Data.Stream (Stream) +import GHC.Data.Stream qualified as Stream +import GHC.Platform +import GHC.Prelude +import GHC.Types.ForeignStubs +import GHC.Unit.Types +import GHC.Utils.Outputable + +generateDebugSymbolStub :: + (MonadIO m) => + Platform -> + Module -> + Stream m RawCmmGroup r -> + Stream m RawCmmGroup (r, CStub) +generateDebugSymbolStub platform this_mod rawcmms0 = do + (lbls_ref, per_group) <- liftIO $ do + lbls_ref <- newIORef Map.empty + let per_group decls = for_ decls per_decl $> decls + per_decl (CmmData _ (CmmStaticsRaw lbl _)) = + liftIO + $ when (externallyVisibleCLabel lbl) + $ modifyIORef' lbls_ref + $ Map.insert lbl (data_label_type lbl) + per_decl (CmmProc h lbl _ _) = case H.mapToList h of + [] -> + liftIO + $ when (externallyVisibleCLabel lbl) + $ modifyIORef' lbls_ref + $ Map.insert lbl (proc_label_type lbl) + hs -> for_ hs $ \(_, CmmStaticsRaw lbl _) -> + liftIO + $ when (externallyVisibleCLabel lbl) + $ modifyIORef' lbls_ref + $ Map.insert lbl (data_label_type lbl) + data_label_type lbl + | "_closure" + `isSuffixOf` str + && not + (str `elem` ["stg_CHARLIKE_closure", "stg_INTLIKE_closure"]) = + Just ("extern StgClosure ", "") + | "_str" `isSuffixOf` str = + Just ("EB_(", ")") + | str + `elem` [ "stg_arg_bitmaps", + "stg_ap_stack_entries", + "stg_stack_save_entries" + ] = + Just ("ERO_(", ")") + | str + `elem` [ "no_break_on_exception", + "stg_scheduler_loop_epoch", + "stg_scheduler_loop_tid" + ] = + Just ("ERW_(", ")") + | str + `elem` [ "stg_gc_prim_p_ll_info", + "stg_gc_prim_pp_ll_info", + "stg_JSVAL_info", + "stg_scheduler_loop_info" + ] = + Just ("extern const StgInfoTable ", "") + | not $ needsCDecl lbl = + Nothing + | "_cc" `isSuffixOf` str = + Just ("extern CostCentre ", "[]") + | "_ccs" `isSuffixOf` str = + Just ("extern CostCentreStack ", "[]") + | "_ipe_buf" `isSuffixOf` str = + Just ("extern IpeBufferListNode ", "") + | otherwise = + Just ("ERW_(", ")") + where + str = + showSDocOneLine defaultSDocContext {sdocStyle = PprCode} + $ pprCLabel platform lbl + proc_label_type _ = Just ("EF_(", ")") + pure (lbls_ref, per_group) + r <- Stream.mapM per_group rawcmms0 + liftIO $ do + lbls <- Map.toList <$> readIORef lbls_ref + let ctor_lbl = mkInitializerStubLabel this_mod $ fsLit "symbolizer" + entries_lbl = + mkInitializerStubLabel this_mod $ fsLit "symbolizer_entries" + ctor_decls = + vcat + [ text lbl_type_l + <> pprCLabel platform lbl + <> text lbl_type_r + <> semi + | (lbl, maybe_lbl_type) <- lbls, + (lbl_type_l, lbl_type_r) <- maybeToList maybe_lbl_type + ] + <> text "static const DebugSymbolEntry " + <> pprCLabel platform entries_lbl + <> text "[] = " + <> braces + ( hsep + $ punctuate + comma + [ braces + $ text ".addr = (void*)&" + <> pprCLabel platform lbl + <> comma + <> text ".sym = " + <> doubleQuotes (pprCLabel platform lbl) + | (lbl, _) <- lbls + ] + ) + <> semi + ctor_body = + text "registerDebugSymbol" + <> parens + (pprCLabel platform entries_lbl <> comma <> int (length lbls)) + <> semi + cstub = case lbls of + [] -> mempty + _ -> initializerCStub platform ctor_lbl ctor_decls ctor_body + pure (r, cstub) ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -26,6 +26,7 @@ import GHC.CmmToC ( cmmToC ) import GHC.Cmm.Lint ( cmmLint ) import GHC.Cmm import GHC.Cmm.CLabel +import GHC.Cmm.GenerateDebugSymbolStub import GHC.StgToCmm.CgUtils (CgStream) @@ -76,7 +77,8 @@ import qualified Data.Set as Set codeOutput :: forall a. - Logger + Platform + -> Logger -> TmpFs -> LlvmConfigCache -> DynFlags @@ -95,7 +97,7 @@ codeOutput (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}), [(ForeignSrcLang, FilePath)]{-foreign_fps-}, a) -codeOutput logger tmpfs llvm_config dflags unit_state this_mod filenm location genForeignStubs foreign_fps pkg_deps dus0 +codeOutput platform logger tmpfs llvm_config dflags unit_state this_mod filenm location genForeignStubs foreign_fps pkg_deps dus0 cmm_stream = do { @@ -119,10 +121,12 @@ codeOutput logger tmpfs llvm_config dflags unit_state this_mod filenm location g ; return cmm } + debug_cmm_stream = generateDebugSymbolStub platform this_mod linted_cmm_stream + ; let final_stream :: CgStream RawCmmGroup (ForeignStubs, a) final_stream = do - { a <- linted_cmm_stream - ; let stubs = genForeignStubs a + { (a, debug_cstub) <- debug_cmm_stream + ; let stubs = genForeignStubs a `appendStubC` debug_cstub ; emitInitializerDecls this_mod stubs ; return (stubs, a) } ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2094,7 +2094,7 @@ hscGenHardCode hsc_env cgguts mod_loc output_filename = do (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, cmm_cg_infos) <- {-# SCC "codeOutput" #-} - codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) this_mod output_filename mod_loc + codeOutput platform logger tmpfs llvm_config dflags (hsc_units hsc_env) this_mod output_filename mod_loc foreign_stubs foreign_files dependencies (initDUniqSupply 'n' 0) rawcmms1 return ( output_filename, stub_c_exists, foreign_fps , Just stg_cg_infos, Just cmm_cg_infos) @@ -2248,7 +2248,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs in NoStubs `appendStubC` ip_init | otherwise = NoStubs (_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos) - <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] S.empty + <- codeOutput platform logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] S.empty dus1 rawCmms return stub_c_exists where ===================================== compiler/GHC/Iface/Tidy/StaticPtrTable.hs ===================================== @@ -17,18 +17,18 @@ -- > static void hs_hpc_init_Main(void) { -- > -- > static StgWord64 k0[2] = {16252233372134256ULL,7370534374096082ULL}; --- > extern StgPtr Main_r2wb_closure; +-- > extern StgClosure Main_r2wb_closure; -- > hs_spt_insert(k0, &Main_r2wb_closure); -- > -- > static StgWord64 k1[2] = {12545634534567898ULL,5409674567544151ULL}; --- > extern StgPtr Main_r2wc_closure; +-- > extern StgClosure Main_r2wc_closure; -- > hs_spt_insert(k1, &Main_r2wc_closure); -- > -- > } -- -- where the constants are fingerprints produced from the static forms. -- --- The linker must find the definitions matching the @extern StgPtr <name>@ +-- The linker must find the definitions matching the @extern StgClosure <name>@ -- declarations. For this to work, the identifiers of static pointers need to be -- exported. This is done in 'GHC.Core.Opt.SetLevels.newLvlVar'. -- @@ -256,7 +256,7 @@ sptModuleInitCode platform this_mod entries init_fn_body = vcat [ text "static StgWord64 k" <> int i <> text "[2] = " <> pprFingerprint fp <> semi - $$ text "extern StgPtr " + $$ text "extern StgClosure " <> (pprCLabel platform $ mkClosureLabel (idName n) (idCafInfo n)) <> semi $$ text "hs_spt_insert" <> parens (hcat $ punctuate comma ===================================== compiler/ghc.cabal.in ===================================== @@ -242,6 +242,7 @@ Library GHC.Cmm.Dataflow.Label GHC.Cmm.DebugBlock GHC.Cmm.Expr + GHC.Cmm.GenerateDebugSymbolStub GHC.Cmm.GenericOpt GHC.Cmm.Graph GHC.Cmm.Info ===================================== configure.ac ===================================== @@ -876,9 +876,6 @@ AC_SUBST([UseLibm]) TargetHasLibm=$UseLibm AC_SUBST(TargetHasLibm) -FP_BFD_FLAG -AC_SUBST([UseLibbfd]) - dnl ################################################################ dnl Check for libraries dnl ################################################################ ===================================== hadrian/cfg/system.config.in ===================================== @@ -120,7 +120,6 @@ use-lib-numa = @UseLibNuma@ use-lib-m = @UseLibm@ use-lib-rt = @UseLibrt@ use-lib-dl = @UseLibdl@ -use-lib-bfd = @UseLibbfd@ use-lib-pthread = @UseLibpthread@ need-libatomic = @NeedLibatomic@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -36,7 +36,6 @@ data Flag = CrossCompiling | UseLibm | UseLibrt | UseLibdl - | UseLibbfd | UseLibpthread | NeedLibatomic | UseGhcToolchain @@ -60,7 +59,6 @@ flag f = do UseLibm -> "use-lib-m" UseLibrt -> "use-lib-rt" UseLibdl -> "use-lib-dl" - UseLibbfd -> "use-lib-bfd" UseLibpthread -> "use-lib-pthread" NeedLibatomic -> "need-libatomic" UseGhcToolchain -> "use-ghc-toolchain" ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -442,7 +442,6 @@ rtsPackageArgs = package rts ? do , useSystemFfi `cabalFlag` "use-system-libffi" , useLibffiForAdjustors `cabalFlag` "libffi-adjustors" , flag UseLibpthread `cabalFlag` "need-pthread" - , flag UseLibbfd `cabalFlag` "libbfd" , flag NeedLibatomic `cabalFlag` "need-atomic" , flag UseLibdw `cabalFlag` "libdw" , flag UseLibnuma `cabalFlag` "libnuma" ===================================== m4/fp_bfd_support.m4 deleted ===================================== @@ -1,59 +0,0 @@ -# FP_BFD_SUPPORT() -# ---------------------- -# Whether to use libbfd for debugging RTS -# -# Sets: -# UseLibbfd: [YES|NO] -AC_DEFUN([FP_BFD_FLAG], [ - UseLibbfd=NO - AC_ARG_ENABLE(bfd-debug, - [AS_HELP_STRING([--enable-bfd-debug], - [Enable symbol resolution for -debug rts ('+RTS -Di') via binutils' libbfd [default=no]])], - [UseLibbfd=YES], - [UseLibbfd=NO]) -]) - -# FP_WHEN_ENABLED_BFD -# ---------------------- -# Checks for libraries in the default way, which will define various -# `HAVE_*` macros. -AC_DEFUN([FP_WHEN_ENABLED_BFD], [ - # don't pollute general LIBS environment - save_LIBS="$LIBS" - AC_CHECK_HEADERS([bfd.h]) - dnl ** check whether this machine has BFD and libiberty installed (used for debugging) - dnl the order of these tests matters: bfd needs libiberty - AC_CHECK_LIB(iberty, xmalloc) - dnl 'bfd_init' is a rare non-macro in libbfd - AC_CHECK_LIB(bfd, bfd_init) - - AC_LINK_IFELSE( - [AC_LANG_PROGRAM( - [[#include ]], - [[ - /* mimic our rts/Printer.c */ - bfd* abfd; - const char * name; - char **matching; - - name = "some.executable"; - bfd_init(); - abfd = bfd_openr(name, "default"); - bfd_check_format_matches (abfd, bfd_object, &matching); - { - long storage_needed; - storage_needed = bfd_get_symtab_upper_bound (abfd); - } - { - asymbol **symbol_table; - long number_of_symbols; - symbol_info info; - - number_of_symbols = bfd_canonicalize_symtab (abfd, symbol_table); - bfd_get_symbol_info(abfd,symbol_table[0],&info); - } - ]])], - [], dnl bfd seems to work - [AC_MSG_ERROR([can't use 'bfd' library])]) - LIBS="$save_LIBS" -]) ===================================== rts/Printer.c ===================================== @@ -43,13 +43,20 @@ static void printStdObjPayload( const StgClosure *obj ); void printPtr( StgPtr p ) { const char *raw; - raw = lookupGHCName(p); + raw = lookupDebugSymbol(p); if (raw != NULL) { - debugBelch("<%s>", raw); - debugBelch("[%p]", p); - } else { - debugBelch("%p", p); + debugBelch("<%s>[%p]", raw, p); + return; } + + StgPtr p0 = (StgPtr)UNTAG_CLOSURE((StgClosure *)p); + raw = lookupDebugSymbol(p0); + if (raw != NULL) { + debugBelch("<%s>[%p+%td]", raw, p0, p - p0); + return; + } + + debugBelch("%p", p); } void printObj( StgClosure *obj ) @@ -853,129 +860,6 @@ void printLargeAndPinnedObjects(void) * Uses symbol table in (unstripped executable) * ------------------------------------------------------------------------*/ -/* -------------------------------------------------------------------------- - * Simple lookup table - * address -> function name - * ------------------------------------------------------------------------*/ - -static HashTable * add_to_fname_table = NULL; - -const char *lookupGHCName( void *addr ) -{ - if (add_to_fname_table == NULL) - return NULL; - - return lookupHashTable(add_to_fname_table, (StgWord)addr); -} - -/* -------------------------------------------------------------------------- - * Symbol table loading - * ------------------------------------------------------------------------*/ - -/* Causing linking trouble on Win32 plats, so I'm - disabling this for now. -*/ -#if defined(USING_LIBBFD) -# define PACKAGE 1 -# define PACKAGE_VERSION 1 -/* Those PACKAGE_* defines are workarounds for bfd: - * https://sourceware.org/bugzilla/show_bug.cgi?id=14243 - * ghc's build system filter PACKAGE_* values out specifically to avoid clashes - * with user's autoconf-based Cabal packages. - * It's a shame checks for unrelated fields instead of actually used - * macros. - */ -# include - -/* Fairly ad-hoc piece of code that seems to filter out a lot of - * rubbish like the obj-splitting symbols - */ - -static bool isReal( flagword flags STG_UNUSED, const char *name ) -{ -#if 0 - /* ToDo: make this work on BFD */ - int tp = type & N_TYPE; - if (tp == N_TEXT || tp == N_DATA) { - return (name[0] == '_' && name[1] != '_'); - } else { - return false; - } -#else - if (*name == '\0' || - (name[0] == 'g' && name[1] == 'c' && name[2] == 'c') || - (name[0] == 'c' && name[1] == 'c' && name[2] == '.')) { - return false; - } - return true; -#endif -} - -extern void DEBUG_LoadSymbols( const char *name ) -{ - bfd* abfd; - char **matching; - - bfd_init(); - abfd = bfd_openr(name, "default"); - if (abfd == NULL) { - barf("can't open executable %s to get symbol table", name); - } - if (!bfd_check_format_matches (abfd, bfd_object, &matching)) { - barf("mismatch"); - } - - { - long storage_needed; - asymbol **symbol_table; - long number_of_symbols; - long num_real_syms = 0; - long i; - - storage_needed = bfd_get_symtab_upper_bound (abfd); - - if (storage_needed < 0) { - barf("can't read symbol table"); - } - symbol_table = (asymbol **) stgMallocBytes(storage_needed,"DEBUG_LoadSymbols"); - - number_of_symbols = bfd_canonicalize_symtab (abfd, symbol_table); - - if (number_of_symbols < 0) { - barf("can't canonicalise symbol table"); - } - - if (add_to_fname_table == NULL) - add_to_fname_table = allocHashTable(); - - for( i = 0; i != number_of_symbols; ++i ) { - symbol_info info; - bfd_get_symbol_info(abfd,symbol_table[i],&info); - if (isReal(info.type, info.name)) { - insertHashTable(add_to_fname_table, - info.value, (void*)info.name); - num_real_syms += 1; - } - } - - IF_DEBUG(interpreter, - debugBelch("Loaded %ld symbols. Of which %ld are real symbols\n", - number_of_symbols, num_real_syms) - ); - - stgFree(symbol_table); - } -} - -#else /* USING_LIBBFD */ - -extern void DEBUG_LoadSymbols( const char *name STG_UNUSED ) -{ - /* nothing, yet */ -} - -#endif /* USING_LIBBFD */ - void findPtr(P_ p, int); /* keep gcc -Wall happy */ int searched = 0; @@ -1080,6 +964,31 @@ void printObj( StgClosure *obj ) #endif /* DEBUG */ +/* -------------------------------------------------------------------------- + * Simple lookup table + * address -> function name + * ------------------------------------------------------------------------*/ + +static HashTable * add_to_fname_table = NULL; + +void registerDebugSymbol( const DebugSymbolEntry entries[], int len ) { + if (add_to_fname_table == NULL) { + add_to_fname_table = allocHashTable(); + } + + for (int i = 0; i < len; ++i) { + insertHashTable(add_to_fname_table, (StgWord)entries[i].addr, entries[i].sym); + } +} + +const char *lookupDebugSymbol( void *addr ) +{ + if (add_to_fname_table == NULL) + return NULL; + + return lookupHashTable(add_to_fname_table, (StgWord)addr); +} + /* ----------------------------------------------------------------------------- Closure types ===================================== rts/Printer.h ===================================== @@ -30,11 +30,9 @@ extern void printStaticObjects ( StgClosure *obj ); extern void printWeakLists ( void ); extern void printLargeAndPinnedObjects ( void ); -extern void DEBUG_LoadSymbols( const char *name ); - -extern const char *lookupGHCName( void *addr ); - extern const char *what_next_strs[]; #endif +extern const char *lookupDebugSymbol( void *addr ); + #include "EndPrivate.h" ===================================== rts/RtsStartup.c ===================================== @@ -15,7 +15,6 @@ #include "RtsFlags.h" #include "RtsUtils.h" #include "Prelude.h" -#include "Printer.h" /* DEBUG_LoadSymbols */ #include "Schedule.h" /* initScheduler */ #include "Stats.h" /* initStats */ #include "STM.h" /* initSTM */ @@ -326,11 +325,6 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) } else { setFullProgArgv(*argc,*argv); setupRtsFlags(argc, *argv, rts_config); - -#if defined(DEBUG) - /* load debugging symbols for current binary */ - DEBUG_LoadSymbols((*argv)[0]); -#endif /* DEBUG */ } /* Based on the RTS flags, decide which I/O manager to use. */ ===================================== rts/configure.ac ===================================== @@ -171,8 +171,6 @@ AS_IF( [test "$CABAL_FLAG_libm" = 1], [AC_DEFINE([HAVE_LIBM], [1], [Define to 1 if you need to link with libm])]) -AS_IF([test "$CABAL_FLAG_libbfd" = 1], [FP_WHEN_ENABLED_BFD]) - dnl ################################################################ dnl Check for libraries dnl ################################################################ ===================================== rts/include/Rts.h ===================================== @@ -283,6 +283,7 @@ void _warnFail(const char *filename, unsigned int linenum); #include "rts/StaticPtrTable.h" #include "rts/Libdw.h" #include "rts/LibdwPool.h" +#include "rts/Debug.h" /* Misc stuff without a home */ DLL_IMPORT_RTS extern char **prog_argv; /* so we can get at these from Haskell */ ===================================== rts/include/rts/Config.h ===================================== @@ -19,13 +19,6 @@ #error TICKY_TICKY is incompatible with THREADED_RTS #endif -/* - * Whether the runtime system will use libbfd for debugging purposes. - */ -#if defined(DEBUG) && defined(HAVE_BFD_H) && defined(HAVE_LIBBFD) && !defined(_WIN32) -#define USING_LIBBFD 1 -#endif - /* * We previously only offer the eventlog in a subset of RTS ways; we now * enable it unconditionally to simplify packaging. See #18948. @@ -101,4 +94,3 @@ code. #else #define CACHELINE_SIZE 64 #endif - ===================================== rts/include/rts/Debug.h ===================================== @@ -0,0 +1,18 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2017-2025 + * + * Debug API + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * -------------------------------------------------------------------------- */ + +#pragma once + +typedef struct { void *addr; const char *sym; } DebugSymbolEntry; + +void registerDebugSymbol( const DebugSymbolEntry entries[], int len ); ===================================== rts/rts.cabal ===================================== @@ -46,9 +46,6 @@ flag libffi-adjustors flag need-pthread default: False manual: True -flag libbfd - default: False - manual: True flag need-atomic default: False manual: True @@ -250,9 +247,6 @@ library if flag(need-atomic) -- for sub-word-sized atomic operations (#19119) extra-libraries: atomic - if flag(libbfd) - -- for debugging - extra-libraries: bfd iberty if flag(libdw) -- for backtraces extra-libraries: elf dw @@ -286,6 +280,7 @@ library rts/Bytecodes.h rts/Config.h rts/Constants.h + rts/Debug.h rts/EventLogFormat.h rts/EventLogWriter.h rts/FileLock.h View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2924dad40c01ccde7278a75207ca7df... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2924dad40c01ccde7278a75207ca7df... You're receiving this email because of your account on gitlab.haskell.org.