- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/T25974] Localize `$toolchain`, change `$PATH` only when `TOOLCHAIN_SOURCE=extracted`
by Serge S. Gulin (＠gulin.serge) 19 May '25

19 May '25

Serge S. Gulin pushed to branch wip/T25974 at Glasgow Haskell Compiler / GHC Commits: 44634f11 by Serge S. Gulin at 2025-05-20T00:07:19+03:00 Localize `$toolchain`, change `$PATH` only when `TOOLCHAIN_SOURCE=extracted` - - - - - 1 changed file: - .gitlab/ci.sh Changes: ===================================== .gitlab/ci.sh ===================================== @@ -22,16 +22,16 @@ CABAL_CACHE="$TOP/${CABAL_CACHE:-cabal-cache}" source "$TOP/.gitlab/common.sh" function time_it() { - local name="$1" + local -r name="$1" shift - local start=$(date +%s) + local -r start=$(date +%s) local res=0 set +e ( set -e ; $@ ) res=$? set -e - local end=$(date +%s) - local delta=$(expr $end - $start) + local -r end=$(date +%s) + local -r delta=$((end - start)) echo "$name took $delta seconds" printf "%15s | $delta" > ci-timings @@ -83,7 +83,8 @@ Environment variables affecting both build systems: - "extracted": Toolchains will be downloaded and extracted through the CI process. Default for other systems. Windows and FreeBSD - are included. + are included. PATH variable will be extended with a location + to which toolchains will be installed. Environment variables determining build configuration of Hadrian system: @@ -176,11 +177,6 @@ function mingw_init() { esac } -# This will contain GHC's local native toolchain -toolchain="$TOP/toolchain" -mkdir -p "$toolchain/bin" -PATH="$toolchain/bin:$PATH" - export METRICS_FILE="$TOP/performance-metrics.tsv" cores="$(mk/detect-cpu-count.sh)" @@ -198,6 +194,8 @@ function show_tool() { } function set_toolchain_paths() { + local -r toolchain_path="$1" + if [ -z "${TOOLCHAIN_SOURCE:-}" ] then # Fallback to automatic detection which could not work for cases @@ -214,11 +212,14 @@ function set_toolchain_paths() { case "$TOOLCHAIN_SOURCE" in extracted) + mkdir -p "$toolchain_path/bin" + PATH="$toolchain_path/bin:$PATH" + # These are populated by setup_toolchain - GHC="$toolchain/bin/ghc$exe" - CABAL="$toolchain/bin/cabal$exe" - HAPPY="$toolchain/bin/happy$exe" - ALEX="$toolchain/bin/alex$exe" + GHC="$toolchain_path/bin/ghc$exe" + CABAL="$toolchain_path/bin/cabal$exe" + HAPPY="$toolchain_path/bin/happy$exe" + ALEX="$toolchain_path/bin/alex$exe" if [ "$(uname)" = "FreeBSD" ]; then GHC=/usr/local/bin/ghc fi @@ -265,6 +266,8 @@ function cabal_update() { # Extract GHC toolchain function setup() { + local -r toolchain_path="$1" + echo "=== TIMINGS ===" > ci-timings if [ -d "$CABAL_CACHE" ]; then @@ -274,7 +277,7 @@ function setup() { fi case $TOOLCHAIN_SOURCE in - extracted) time_it "setup" setup_toolchain ;; + extracted) time_it "setup" setup_toolchain "${toolchain_path}" ;; *) ;; esac @@ -299,6 +302,8 @@ function setup() { } function fetch_ghc() { + local -r toolchain_path="$1" + local boot_triple_to_fetch case "$(uname)" in MSYS_*|MINGW*) @@ -324,31 +329,33 @@ function fetch_ghc() { readonly boot_triple_to_fetch local -r v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "neither GHC nor GHC_VERSION are not set" - fi + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi - start_section "fetch GHC" - url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot…" - info "Fetching GHC binary distribution from $url..." - curl "$url" > ghc.tar.xz || fail "failed to fetch GHC binary distribution" - $TAR -xJf ghc.tar.xz || fail "failed to extract GHC binary distribution" - case "$(uname)" in - MSYS_*|MINGW*) - cp -r ghc-${GHC_VERSION}*/* "$toolchain" - ;; - *) - pushd ghc-${GHC_VERSION}* - ./configure --prefix="$toolchain" - "$MAKE" install - popd - ;; - esac - rm -Rf "ghc-${GHC_VERSION}" ghc.tar.xz - end_section "fetch GHC" + start_section "fetch GHC" + local -r url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot…" + info "Fetching GHC binary distribution from $url..." + curl "$url" > ghc.tar.xz || fail "failed to fetch GHC binary distribution" + $TAR -xJf ghc.tar.xz || fail "failed to extract GHC binary distribution" + case "$(uname)" in + MSYS_*|MINGW*) + cp -r ghc-${GHC_VERSION}*/* "$toolchain_path" + ;; + *) + pushd ghc-${GHC_VERSION}* + ./configure --prefix="$toolchain_path" + "$MAKE" install + popd + ;; + esac + rm -Rf "ghc-${GHC_VERSION}" ghc.tar.xz + end_section "fetch GHC" } function fetch_cabal() { + local -r toolchain_path="$1" + local v="$CABAL_INSTALL_VERSION" if [[ -z "$v" ]]; then fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" @@ -381,9 +388,9 @@ function fetch_cabal() { $TAR -xJf cabal.tar.xz # Check if the bindist has directory structure if [[ "$tmp" = "cabal" ]]; then - mv cabal "$toolchain/bin" + mv cabal "${toolchain_path}/bin" else - mv "$tmp/cabal" "$toolchain/bin" + mv "$tmp/cabal" "${toolchain_path}/bin" fi ;; esac @@ -394,12 +401,14 @@ function fetch_cabal() { # here. For Docker platforms this is done in the Docker image # build. function setup_toolchain() { + local -r toolchain_path="$1" + if [ ! -e "$GHC" ]; then - fetch_ghc + fetch_ghc "${toolchain_path}" fi if [ ! -e "$CABAL" ]; then - fetch_cabal + fetch_cabal "${toolchain_path}" fi cabal_update @@ -407,7 +416,7 @@ function setup_toolchain() { local cabal_install="$CABAL v2-install \ --with-compiler=$GHC \ --index-state=$HACKAGE_INDEX_STATE \ - --installdir=$toolchain/bin \ + --installdir=${toolchain_path}/bin \ --ignore-project \ --overwrite-policy=always" @@ -1081,11 +1090,13 @@ if [[ -z ${BIGNUM_BACKEND:-} ]]; then BIGNUM_BACKEND=gmp; fi determine_metric_baseline -set_toolchain_paths +# This will contain GHC's local native toolchain when TOOLCHAIN_SOURCE=extracted +toolchain="$TOP/toolchain" +set_toolchain_paths "${toolchain}" case ${1:-help} in help|usage) usage ;; - setup) setup && cleanup_submodules ;; + setup) setup "${toolchain}" && cleanup_submodules ;; configure) time_it "configure" configure ;; build_hadrian) time_it "build" build_hadrian ;; # N.B. Always push notes, even if the build fails. This is okay to do as the View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44634f113a58771500430c7f5d51fb4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44634f113a58771500430c7f5d51fb4… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26009] fixup! rts/linker/PEi386: Mark const arguments
by Ben Gamari (＠bgamari) 19 May '25

19 May '25

Ben Gamari pushed to branch wip/T26009 at Glasgow Haskell Compiler / GHC Commits: 6a1cf6ff by Ben Gamari at 2025-05-19T16:49:06-04:00 fixup! rts/linker/PEi386: Mark const arguments - - - - - 2 changed files: - rts/PathUtils.c - rts/PathUtils.h Changes: ===================================== rts/PathUtils.c ===================================== @@ -13,7 +13,7 @@ #include <wchar.h> #endif -pathchar* pathdup(pathchar *path) +pathchar* pathdup(const pathchar *path) { pathchar *ret; #if defined(mingw32_HOST_OS) @@ -26,7 +26,7 @@ pathchar* pathdup(pathchar *path) return ret; } -pathchar* pathdir(pathchar *path) +pathchar* pathdir(const pathchar *path) { pathchar *ret; #if defined(mingw32_HOST_OS) @@ -50,7 +50,7 @@ pathchar* pathdir(pathchar *path) return ret; } -pathchar* mkPath(char* path) +pathchar* mkPath(const char* path) { #if defined(mingw32_HOST_OS) size_t required = mbstowcs(NULL, path, 0); @@ -66,7 +66,7 @@ pathchar* mkPath(char* path) #endif } -HsBool endsWithPath(pathchar* base, pathchar* str) { +HsBool endsWithPath(const pathchar* base, const pathchar* str) { int blen = pathlen(base); int slen = pathlen(str); return (blen >= slen) && (0 == pathcmp(base + blen - slen, str)); ===================================== rts/PathUtils.h ===================================== @@ -37,9 +37,9 @@ #include "BeginPrivate.h" -pathchar* pathdup(pathchar *path); -pathchar* pathdir(pathchar *path); -pathchar* mkPath(char* path); -HsBool endsWithPath(pathchar* base, pathchar* str); +p*athchar* pathdup(const pathchar *path); +pathchar* pathdir(const pathchar *path); +pathchar* mkPath(const char* path); +HsBool endsWithPath(const pathchar* base, const pathchar* str); #include "EndPrivate.h" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a1cf6ffb6d6d6e60a5a6034fb0ad4e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a1cf6ffb6d6d6e60a5a6034fb0ad4e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26009] 3 commits: rts/linker/PEi386: Don't double-load DLLs
by Ben Gamari (＠bgamari) 19 May '25

19 May '25

Ben Gamari pushed to branch wip/T26009 at Glasgow Haskell Compiler / GHC Commits: 79a58ed3 by Ben Gamari at 2025-05-19T16:31:37-04:00 rts/linker/PEi386: Don't double-load DLLs Previously the happy path of PEi386 used `break` in a double-`for` loop resulting in redundant calls to `LoadLibraryEx`. Fixes #26052. - - - - - 7c9d6e7d by Ben Gamari at 2025-05-19T16:46:22-04:00 rts/linker/PEi386: Mark const arguments - - - - - ecd20c03 by Ben Gamari at 2025-05-19T16:46:26-04:00 rts/linker/PEi386: Don't repeatedly load DLLs Previously every DLL-imported symbol would result in a call to `LoadLibraryEx`. This ended up constituting over 40% of the runtime of `ghc --interactive -e 42` on Windows. Avoid this by maintaining a hash-set of loaded DLL names, skipping the call if we have already loaded the requested DLL. Addresses #26009. - - - - - 2 changed files: - rts/linker/PEi386.c - rts/linker/PEi386.h Changes: ===================================== rts/linker/PEi386.c ===================================== @@ -378,7 +378,7 @@ static size_t makeSymbolExtra_PEi386( #endif static void addDLLHandle( - pathchar* dll_name, + const pathchar* dll_name, HINSTANCE instance); static bool verifyCOFFHeader( @@ -427,8 +427,52 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; +/* + * Note [Avoiding repeated DLL loading] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * As LoadLibraryEx tends to be expensive and addDLL_PEi386 is called on every + * DLL-imported symbol, we use a hash-map to keep track of which DLLs have + * already been loaded. This hash-map is keyed on the dll_name passed to + * addDLL_PEi386 and is mapped to its HINSTANCE. This serves as a quick check + * to avoid repeated calls to LoadLibraryEx for the identical DLL. See #26009. + */ + +typedef struct { + HashTable *hash; +} LoadedDllCache; + +LoadedDllCache loaded_dll_cache; + +static void initLoadedDllCache(LoadedDllCache *cache) { + cache->hash = allocHashTable(); +} + +static int hash_path(const HashTable *table, StgWord w) +{ + const pathchar *key = (pathchar*) w; + return hashBuffer(table, key, sizeof(pathchar) * wcslen(key)); +} + +static int compare_path(StgWord key1, StgWord key2) +{ + return wcscmp((pathchar*) key1, (pathchar*) key2); +} + +static void addLoadedDll(LoadedDllCache *cache, const pathchar *dll_name, HINSTANCE instance) +{ + insertHashTable_(cache->hash, (StgWord) dll_name, instance, hash_path); +} + +static HINSTANCE isDllLoaded(const LoadedDllCache *cache, const pathchar *dll_name) +{ + void *result = lookupHashTable_(cache->hash, (StgWord) dll_name, hash_path, compare_path); + return (HINSTANCE) result; +} + void initLinker_PEi386(void) { + initLoadedDllCache(&loaded_dll_cache); + if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), symhash, "__image_base__", GetModuleHandleW (NULL), HS_BOOL_TRUE, @@ -455,7 +499,7 @@ void exitLinker_PEi386(void) static OpenedDLL* opened_dlls = NULL; /* Adds a DLL instance to the list of DLLs in which to search for symbols. */ -static void addDLLHandle(pathchar* dll_name, HINSTANCE instance) { +static void addDLLHandle(const pathchar* dll_name, HINSTANCE instance) { IF_DEBUG(linker, debugBelch("addDLLHandle(%" PATH_FMT ")...\n", dll_name)); /* At this point, we actually know what was loaded. @@ -797,11 +841,18 @@ uint8_t* getSymShortName ( COFF_HEADER_INFO *info, COFF_symbol* sym ) } const char * -addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) +addDLL_PEi386( const pathchar *dll_name, HINSTANCE *loaded ) { /* ------------------- Win32 DLL loader ------------------- */ IF_DEBUG(linker, debugBelch("addDLL; dll_name = `%" PATH_FMT "'\n", dll_name)); + // See Note [Avoiding repeated DLL loading] + HINSTANCE instance = isDllLoaded(&loaded_dll_cache, dll_name); + if (instance) { + *loaded = instance; + return NULL; + } + /* The file name has no suffix (yet) so that we can try both foo.dll and foo.drv @@ -820,7 +871,6 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) const DWORD flags[] = { LOAD_LIBRARY_SEARCH_USER_DIRS | LOAD_LIBRARY_SEARCH_DEFAULT_DIRS, 0 }; /* Iterate through the possible flags and formats. */ - HINSTANCE instance; for (int cFlag = 0; cFlag < 2; cFlag++) { for (int cFormat = 0; cFormat < 4; cFormat++) { snwprintf(buf, bufsize, formats[cFormat], dll_name); @@ -830,16 +880,18 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) goto error; } } else { - break; /* We're done. DLL has been loaded. */ + goto loaded; /* We're done. DLL has been loaded. */ } } } +loaded: /* Check if we managed to load the DLL. */ if (instance == NULL) { goto error; } + addLoadedDll(&loaded_dll_cache, dll_name, instance); addDLLHandle(buf, instance); if (loaded) { *loaded = instance; ===================================== rts/linker/PEi386.h ===================================== @@ -45,7 +45,7 @@ typedef struct _COFF_HEADER_INFO { void initLinker_PEi386( void ); void exitLinker_PEi386( void ); -const char * addDLL_PEi386( pathchar *dll_name, HINSTANCE *instance ); +const char * addDLL_PEi386( const pathchar *dll_name, HINSTANCE *instance ); void freePreloadObjectFile_PEi386( ObjectCode *oc ); bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43e32a72c6308057d4f0511b339569… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43e32a72c6308057d4f0511b339569… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26009] rts/linker/PEi386: Don't repeated load DLLs
by Ben Gamari (＠bgamari) 19 May '25

19 May '25

Ben Gamari pushed to branch wip/T26009 at Glasgow Haskell Compiler / GHC Commits: 43e32a72 by Ben Gamari at 2025-05-19T16:05:09-04:00 rts/linker/PEi386: Don't repeated load DLLs Previously every DLL-imported symbol would result in a call to `LoadLibraryEx`. This ended up constituting over 40% of the runtime of `ghc --interactive -e 42` on Windows. Avoid this by maintaining a hash-set of loaded DLL names, skipping the call if we have already loaded the requested DLL. Addresses #26009. - - - - - 1 changed file: - rts/linker/PEi386.c Changes: ===================================== rts/linker/PEi386.c ===================================== @@ -427,8 +427,52 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; +/* + * Note [Avoiding repeated DLL loading] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * As LoadLibraryEx tends to be expensive and addDLL_PEi386 is called on every + * DLL-imported symbol, we use a hash-set to keep track of which DLLs have + * already been loaded. This hash-set is keyed on the dll_name passed to + * addDLL_PEi386 and serves as a quick check to avoid repeated calls to + * LoadLibraryEx for the identical DLL. See #26009. + */ + +typedef struct { + HashTable *hash; +} LoadedDllSet; + +LoadedDllSet loaded_dll_set; + +static void initLoadedDllSet(LoadedDllSet *set) { + set->hash = allocHashTable(); +} + +static int hash_path(const HashTable *table, StgWord w) +{ + const pathchar *key = (pathchar*) w; + return hashBuffer(table, key, sizeof(pathchar) * wcslen(key)); +} + +static int compare_path(StgWord key1, StgWord key2) +{ + return wcscmp((pathchar*) key1, (pathchar*) key2); +} + +static void addLoadedDll(LoadedDllSet *set, pathchar *dll_name) +{ + insertHashTable_(set->hash, (StgWord) dll_name, (void*) 1, hash_path); +} + +static bool isDllLoaded(LoadedDllSet *set, pathchar *dll_name) +{ + void * result = lookupHashTable_(set->hash, (StgWord) dll_name, hash_path, compare_path); + return result != NULL; +} + void initLinker_PEi386(void) { + initLoadedDllSet(&loaded_dll_set); + if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), symhash, "__image_base__", GetModuleHandleW (NULL), HS_BOOL_TRUE, @@ -802,6 +846,10 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) /* ------------------- Win32 DLL loader ------------------- */ IF_DEBUG(linker, debugBelch("addDLL; dll_name = `%" PATH_FMT "'\n", dll_name)); + if (isDllLoaded(&loaded_dll_set, dll_name)) { + return NULL; + } + /* The file name has no suffix (yet) so that we can try both foo.dll and foo.drv @@ -840,6 +888,7 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) goto error; } + addLoadedDll(&loaded_dll_set, dll_name); addDLLHandle(buf, instance); if (loaded) { *loaded = instance; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43e32a72c6308057d4f0511b3395694… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43e32a72c6308057d4f0511b3395694… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26009] 2 commits: rts/Hash: Factor out hashBuffer
by Ben Gamari (＠bgamari) 19 May '25

19 May '25

Ben Gamari pushed to branch wip/T26009 at Glasgow Haskell Compiler / GHC Commits: 827961b9 by Ben Gamari at 2025-05-19T16:01:12-04:00 rts/Hash: Factor out hashBuffer This is a useful helper which can be used for non-strings as well. - - - - - deadc2ef by Ben Gamari at 2025-05-19T16:01:24-04:00 rts/linker/PEi386: Don't repeated load DLLs Previously every DLL-imported symbol would result in a call to `LoadLibraryEx`. This ended up constituting over 40% of the runtime of `ghc --interactive -e 42` on Windows. Avoid this by maintaining a hash-set of loaded DLL names, skipping the call if we have already loaded the requested DLL. Addresses #26009. - - - - - 3 changed files: - rts/Hash.c - rts/Hash.h - rts/linker/PEi386.c Changes: ===================================== rts/Hash.c ===================================== @@ -94,13 +94,13 @@ hashWord(const HashTable *table, StgWord key) } int -hashStr(const HashTable *table, StgWord w) +hashBuffer(const HashTable *table, const void *buf, size_t len) { - const char *key = (char*) w; + const char *key = (char*) buf; #if WORD_SIZE_IN_BITS == 64 - StgWord h = XXH3_64bits_withSeed (key, strlen(key), 1048583); + StgWord h = XXH3_64bits_withSeed (key, len, 1048583); #else - StgWord h = XXH32 (key, strlen(key), 1048583); + StgWord h = XXH32 (key, len, 1048583); #endif /* Mod the size of the hash table (a power of 2) */ @@ -114,6 +114,13 @@ hashStr(const HashTable *table, StgWord w) return bucket; } +int +hashStr(const HashTable *table, StgWord w) +{ + const char *key = (char*) w; + return hashBuffer(table, key, strlen(key)); +} + STATIC_INLINE int compareWord(StgWord key1, StgWord key2) { ===================================== rts/Hash.h ===================================== @@ -69,6 +69,10 @@ void * removeStrHashTable ( StrHashTable *table, const char * key, */ typedef int HashFunction(const HashTable *table, StgWord key); typedef int CompareFunction(StgWord key1, StgWord key2); + +// Helper for implementing hash functions +int hashBuffer(const HashTable *table, const void *buf, size_t len); + int hashWord(const HashTable *table, StgWord key); int hashStr(const HashTable *table, StgWord w); void insertHashTable_ ( HashTable *table, StgWord key, @@ -79,6 +83,7 @@ void * removeHashTable_ ( HashTable *table, StgWord key, const void *data, HashFunction f, CompareFunction cmp ); + /* Freeing hash tables */ void freeHashTable ( HashTable *table, void (*freeDataFun)(void *) ); ===================================== rts/linker/PEi386.c ===================================== @@ -427,8 +427,53 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; +/* + * Note [Avoiding repeated DLL loading] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * As LoadLibraryEx tends to be expensive and addDLL_PEi386 is called on every + * DLL-imported symbol, we use a hash-set to keep track of which DLLs have + * already been loaded. This hash-set is keyed on the dll_name passed to + * addDLL_PEi386 and serves as a quick check to avoid repeated calls to + * LoadLibraryEx for the identical DLL. See #26009. + */ + +typedef struct { + HashTable *hash; +} LoadedDllSet; + +LoadedDllSet loaded_dll_set; + +void initLoadedDllSet(LoadedDllSet *set) { + set->hash = allocHashTable(); +} + +int hash_path(const HashTable *table, StgWord w) +{ + const pathchar *key = (pathchar*) w; + return hashBuffer(table, key, sizeof(pathchar) * wcslen(key)); +} + +int compare_path(StgWord key1, StgWord key2) +{ + return wscmp((pathchar*) key1, (pathchar*) key2); +} + +void addLoadedDll(LoadedDllSet *set, pathchar *dll_name) +{ + insertHashTable_(set->hash, (StgWord) dll_name, (void*) 1, hash_path); +} + +bool isDllLoaded(LoadedDllSet *set, pathchar *dll_name) +{ + void * result = lookupHashTable_(set->hash, (StgWord) dll_name, hash_path, compare_path); + return result != NULL; +} + + void initLinker_PEi386(void) { + initLoadedDllSet(&loaded_dll_set); + if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), symhash, "__image_base__", GetModuleHandleW (NULL), HS_BOOL_TRUE, @@ -802,6 +847,10 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) /* ------------------- Win32 DLL loader ------------------- */ IF_DEBUG(linker, debugBelch("addDLL; dll_name = `%" PATH_FMT "'\n", dll_name)); + if (isDllLoaded(&loaded_dll_set, dll_name)) { + return NULL; + } + /* The file name has no suffix (yet) so that we can try both foo.dll and foo.drv @@ -840,6 +889,7 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) goto error; } + addLoadedDll(&loaded_dll_set, dll_name); addDLLHandle(buf, instance); if (loaded) { *loaded = instance; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5cfcf0f90ab2955401ebbd78f417d8… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5cfcf0f90ab2955401ebbd78f417d8… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26009] 7 commits: rts/linker: Factor out ProddableBlocks machinery
by Ben Gamari (＠bgamari) 19 May '25

19 May '25

Ben Gamari pushed to branch wip/T26009 at Glasgow Haskell Compiler / GHC Commits: 2921131c by Ben Gamari at 2025-05-19T15:55:32-04:00 rts/linker: Factor out ProddableBlocks machinery - - - - - e6e69dba by Ben Gamari at 2025-05-19T15:55:32-04:00 rts/linker: Improve efficiency of proddable blocks structure Previously the linker's "proddable blocks" check relied on a simple linked list of spans. This resulted in extremely poor complexity while linking objects with lots of small sections (e.g. objects built with split sections). Rework the mechanism to instead use a simple interval set implemented via binary search. Fixes #26009. - - - - - 915902fc by Ben Gamari at 2025-05-19T15:55:32-04:00 testsuite: Add simple functional test for ProddableBlockSet - - - - - 1f38e273 by Ben Gamari at 2025-05-19T15:55:32-04:00 rts/linker/PEi386: Drop check for LOAD_LIBRARY_SEARCH_*_DIRS The `LOAD_LIBRARY_SEARCH_USER_DIRS` and `LOAD_LIBRARY_SEARCH_DEFAULT_DIRS` were introduced in Windows Vista and have been available every since. As we no longer support Windows XP we can drop this check. Addresses #26009. - - - - - facf379b by Ben Gamari at 2025-05-19T15:55:33-04:00 rts/linker/PEi386: Clean up code style - - - - - 30a7dc99 by Ben Gamari at 2025-05-19T15:56:09-04:00 rts/Hash: Factor out hashBuffer This is a useful helper which can be used for non-strings as well. - - - - - 5cfcf0f9 by Ben Gamari at 2025-05-19T15:58:03-04:00 rts/linker/PEi386: Don't repeated load DLLs Previously every DLL-imported symbol would result in a call to `LoadLibraryEx`. This ended up constituting over 40% of the runtime of `ghc --interactive -e 42` on Windows. Avoid this by maintaining a hash-set of loaded DLL names, skipping the call if we have already loaded the requested DLL. Addresses #26009. - - - - - 13 changed files: - libffi-tarballs - rts/Hash.c - rts/Hash.h - rts/Linker.c - rts/LinkerInternals.h - rts/linker/Elf.c - rts/linker/MachO.c - rts/linker/PEi386.c - + rts/linker/ProddableBlocks.c - + rts/linker/ProddableBlocks.h - rts/rts.cabal - + testsuite/tests/rts/TestProddableBlockSet.c - testsuite/tests/rts/all.T Changes: ===================================== libffi-tarballs ===================================== @@ -1 +1 @@ -Subproject commit ac7fa3132d382056837cad297ab4c66418febb69 +Subproject commit cb280851187d7b509d341be7b50c9a239810feb0 ===================================== rts/Hash.c ===================================== @@ -94,13 +94,13 @@ hashWord(const HashTable *table, StgWord key) } int -hashStr(const HashTable *table, StgWord w) +hashBuffer(const HashTable *table, const void *buf, size_t len) { - const char *key = (char*) w; + const char *key = (char*) buf; #if WORD_SIZE_IN_BITS == 64 - StgWord h = XXH3_64bits_withSeed (key, strlen(key), 1048583); + StgWord h = XXH3_64bits_withSeed (key, len, 1048583); #else - StgWord h = XXH32 (key, strlen(key), 1048583); + StgWord h = XXH32 (key, len, 1048583); #endif /* Mod the size of the hash table (a power of 2) */ @@ -114,6 +114,13 @@ hashStr(const HashTable *table, StgWord w) return bucket; } +int +hashStr(const HashTable *table, StgWord w) +{ + const char *key = (char*) w; + return hashBuffer(table, key, strlen(key)); +} + STATIC_INLINE int compareWord(StgWord key1, StgWord key2) { ===================================== rts/Hash.h ===================================== @@ -69,6 +69,10 @@ void * removeStrHashTable ( StrHashTable *table, const char * key, */ typedef int HashFunction(const HashTable *table, StgWord key); typedef int CompareFunction(StgWord key1, StgWord key2); + +// Helper for implementing hash functions +int hashBuffer(const HashTable *table, const void *buf, size_t len); + int hashWord(const HashTable *table, StgWord key); int hashStr(const HashTable *table, StgWord w); void insertHashTable_ ( HashTable *table, StgWord key, @@ -79,6 +83,7 @@ void * removeHashTable_ ( HashTable *table, StgWord key, const void *data, HashFunction f, CompareFunction cmp ); + /* Freeing hash tables */ void freeHashTable ( HashTable *table, void (*freeDataFun)(void *) ); ===================================== rts/Linker.c ===================================== @@ -1194,7 +1194,7 @@ void freeObjectCode (ObjectCode *oc) stgFree(oc->sections); } - freeProddableBlocks(oc); + freeProddableBlocks(&oc->proddables); freeSegments(oc); /* Free symbol_extras. On x86_64 Windows, symbol_extras are allocated @@ -1279,7 +1279,7 @@ mkOc( ObjectType type, pathchar *path, char *image, int imageSize, oc->sections = NULL; oc->n_segments = 0; oc->segments = NULL; - oc->proddables = NULL; + initProddableBlockSet(&oc->proddables); oc->foreign_exports = NULL; #if defined(NEED_SYMBOL_EXTRAS) oc->symbol_extras = NULL; @@ -1834,50 +1834,6 @@ OStatus getObjectLoadStatus (pathchar *path) return r; } -/* ----------------------------------------------------------------------------- - * Sanity checking. For each ObjectCode, maintain a list of address ranges - * which may be prodded during relocation, and abort if we try and write - * outside any of these. - */ -void -addProddableBlock ( ObjectCode* oc, void* start, int size ) -{ - ProddableBlock* pb - = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock"); - - IF_DEBUG(linker, debugBelch("addProddableBlock: %p %p %d\n", oc, start, size)); - ASSERT(size > 0); - pb->start = start; - pb->size = size; - pb->next = oc->proddables; - oc->proddables = pb; -} - -void -checkProddableBlock (ObjectCode *oc, void *addr, size_t size ) -{ - ProddableBlock* pb; - - for (pb = oc->proddables; pb != NULL; pb = pb->next) { - char* s = (char*)(pb->start); - char* e = s + pb->size; - char* a = (char*)addr; - if (a >= s && (a+size) <= e) return; - } - barf("checkProddableBlock: invalid fixup in runtime linker: %p", addr); -} - -void freeProddableBlocks (ObjectCode *oc) -{ - ProddableBlock *pb, *next; - - for (pb = oc->proddables; pb != NULL; pb = next) { - next = pb->next; - stgFree(pb); - } - oc->proddables = NULL; -} - /* ----------------------------------------------------------------------------- * Section management. */ ===================================== rts/LinkerInternals.h ===================================== @@ -12,6 +12,7 @@ #include "RtsSymbols.h" #include "Hash.h" #include "linker/M32Alloc.h" +#include "linker/ProddableBlocks.h" #if RTS_LINKER_USE_MMAP #include <sys/mman.h> @@ -175,14 +176,6 @@ struct _Section { struct SectionFormatInfo* info; }; -typedef - struct _ProddableBlock { - void* start; - int size; - struct _ProddableBlock* next; - } - ProddableBlock; - typedef struct _Segment { void *start; /* page aligned start address of a segment */ size_t size; /* page rounded size of a segment */ @@ -328,7 +321,7 @@ struct _ObjectCode { /* SANITY CHECK ONLY: a list of the only memory regions which may safely be prodded during relocation. Any attempt to prod outside one of these is an error in the linker. */ - ProddableBlock* proddables; + ProddableBlockSet proddables; #if defined(NEED_SYMBOL_EXTRAS) SymbolExtra *symbol_extras; @@ -434,10 +427,6 @@ void exitLinker( void ); void freeObjectCode (ObjectCode *oc); SymbolAddr* loadSymbol(SymbolName *lbl, RtsSymbolInfo *pinfo); -void addProddableBlock ( ObjectCode* oc, void* start, int size ); -void checkProddableBlock (ObjectCode *oc, void *addr, size_t size ); -void freeProddableBlocks (ObjectCode *oc); - void addSection (Section *s, SectionKind kind, SectionAlloc alloc, void* start, StgWord size, StgWord mapped_offset, void* mapped_start, StgWord mapped_size); ===================================== rts/linker/Elf.c ===================================== @@ -924,7 +924,7 @@ ocGetNames_ELF ( ObjectCode* oc ) oc->sections[i].info->stubs = NULL; #endif - addProddableBlock(oc, start, size); + addProddableBlock(&oc->proddables, start, size); } else { addSection(&oc->sections[i], kind, alloc, oc->image+offset, size, 0, 0, 0); @@ -1272,7 +1272,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, debugBelch("Reloc: P = %p S = %p A = %p type=%d\n", (void*)P, (void*)S, (void*)A, reloc_type )); #if defined(DEBUG) - checkProddableBlock ( oc, pP, sizeof(Elf_Word) ); + checkProddableBlock ( &oc->proddables, pP, sizeof(Elf_Word) ); #else (void) pP; /* suppress unused varialbe warning in non-debug build */ #endif @@ -1684,7 +1684,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, #if defined(DEBUG) IF_DEBUG(linker_verbose,debugBelch("Reloc: P = %p S = %p A = %p\n", (void*)P, (void*)S, (void*)A )); - checkProddableBlock(oc, (void*)P, sizeof(Elf_Word)); + checkProddableBlock(&oc->proddables, (void*)P, sizeof(Elf_Word)); #endif #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) ===================================== rts/linker/MachO.c ===================================== @@ -253,7 +253,7 @@ resolveImports( return 0; } - checkProddableBlock(oc, + checkProddableBlock(&oc->proddables, ((void**)(oc->image + sect->offset)) + i, sizeof(void *)); ((void**)(oc->image + sect->offset))[i] = addr; @@ -287,7 +287,7 @@ decodeAddend(ObjectCode * oc, Section * section, MachORelocationInfo * ri) { /* the instruction. It is 32bit wide */ uint32_t * p = (uint32_t*)((uint8_t*)section->start + ri->r_address); - checkProddableBlock(oc, (void*)p, 1 << ri->r_length); + checkProddableBlock(&oc->proddables, (void*)p, 1 << ri->r_length); switch(ri->r_type) { case ARM64_RELOC_UNSIGNED: { @@ -364,7 +364,7 @@ encodeAddend(ObjectCode * oc, Section * section, MachORelocationInfo * ri, int64_t addend) { uint32_t * p = (uint32_t*)((uint8_t*)section->start + ri->r_address); - checkProddableBlock(oc, (void*)p, 1 << ri->r_length); + checkProddableBlock(&oc->proddables, (void*)p, 1 << ri->r_length); switch (ri->r_type) { case ARM64_RELOC_UNSIGNED: { @@ -788,7 +788,7 @@ relocateSection(ObjectCode* oc, int curSection) default: barf("Unknown size."); } - checkProddableBlock(oc,thingPtr,relocLenBytes); + checkProddableBlock(&oc->proddables,thingPtr,relocLenBytes); /* * With SIGNED_N the relocation is not at the end of the @@ -1034,9 +1034,9 @@ relocateSection(ObjectCode* oc, int curSection) */ if (0 == reloc->r_extern) { if (reloc->r_pcrel) { - checkProddableBlock(oc, (void *)((char *)thing + baseValue), 1); + checkProddableBlock(&oc->proddables, (void *)((char *)thing + baseValue), 1); } else { - checkProddableBlock(oc, (void *)thing, 1); + checkProddableBlock(&oc->proddables, (void *)thing, 1); } } @@ -1343,7 +1343,7 @@ ocGetNames_MachO(ObjectCode* oc) secArray[sec_idx].info->stub_size = 0; secArray[sec_idx].info->stubs = NULL; #endif - addProddableBlock(oc, start, section->size); + addProddableBlock(&oc->proddables, start, section->size); } curMem = (char*) secMem + section->size; ===================================== rts/linker/PEi386.c ===================================== @@ -427,8 +427,53 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; +/* + * Note [Avoiding repeated DLL loading] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * As LoadLibraryEx tends to be expensive and addDLL_PEi386 is called on every + * DLL-imported symbol, we use a hash-set to keep track of which DLLs have + * already been loaded. This hash-set is keyed on the dll_name passed to + * addDLL_PEi386 and serves as a quick check to avoid repeated calls to + * LoadLibraryEx for the identical DLL. See #26009. + */ + +typedef struct { + HashTable *hash; +} LoadedDllSet; + +LoadedDllSet loaded_dll_set; + +void initLoadedDllSet(LoadedDllSet *set) { + set->hash = allocHashTable(); +} + +int hash_path(const HashTable *table, StgWord w) +{ + const pathchar *key = (pathchar*) w; + return hashBuffer(table, key, sizeof(pathchar) * wcslen(key)); +} + +int compare_path(StgWord key1, StgWord key2) +{ + return wscmp((pathchar*) key1, (pathchar*) key2); +} + +void addLoadedDll(LoadedDllSet *set, pathchar *dll_name) +{ + insertHashTable_(set->hash, (StgWord) dll_name, (void*) 1, hash_path); +} + +bool isDllLoaded(LoadedDllSet *set, pathchar *dll_name) +{ + void * result = lookupHashTable_(set->hash, (StgWord) dll_name, hash_path, compare_path); + return result != NULL; +} + + void initLinker_PEi386(void) { + initLoadedDllSet(&loaded_dll_set); + if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), symhash, "__image_base__", GetModuleHandleW (NULL), HS_BOOL_TRUE, @@ -440,10 +485,11 @@ void initLinker_PEi386(void) addDLLHandle(WSTR("*.exe"), GetModuleHandle(NULL)); #endif - /* Register the cleanup routine as an exit handler, this gives other exit handlers - a chance to run which may need linker information. Exit handlers are ran in - reverse registration order so this needs to be before the linker loads anything. */ - atexit (exitLinker_PEi386); + /* Register the cleanup routine as an exit handler, this gives other exit handlers + * a chance to run which may need linker information. Exit handlers are ran in + * reverse registration order so this needs to be before the linker loads anything. + */ + atexit (exitLinker_PEi386); } void exitLinker_PEi386(void) @@ -798,12 +844,12 @@ uint8_t* getSymShortName ( COFF_HEADER_INFO *info, COFF_symbol* sym ) const char * addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) { - /* ------------------- Win32 DLL loader ------------------- */ - - pathchar* buf; - HINSTANCE instance; + /* ------------------- Win32 DLL loader ------------------- */ + IF_DEBUG(linker, debugBelch("addDLL; dll_name = `%" PATH_FMT "'\n", dll_name)); - IF_DEBUG(linker, debugBelch("addDLL; dll_name = `%" PATH_FMT "'\n", dll_name)); + if (isDllLoaded(&loaded_dll_set, dll_name)) { + return NULL; + } /* The file name has no suffix (yet) so that we can try both foo.dll and foo.drv @@ -816,35 +862,23 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) extension. */ size_t bufsize = pathlen(dll_name) + 10; - buf = stgMallocBytes(bufsize * sizeof(wchar_t), "addDLL"); + pathchar *buf = stgMallocBytes(bufsize * sizeof(wchar_t), "addDLL"); /* These are ordered by probability of success and order we'd like them. */ const wchar_t *formats[] = { L"%ls.DLL", L"%ls.DRV", L"lib%ls.DLL", L"%ls" }; const DWORD flags[] = { LOAD_LIBRARY_SEARCH_USER_DIRS | LOAD_LIBRARY_SEARCH_DEFAULT_DIRS, 0 }; - int cFormat, cFlag; - int flags_start = 1; /* Assume we don't support the new API. */ - - /* Detect if newer API are available, if not, skip the first flags entry. */ - if (GetProcAddress((HMODULE)LoadLibraryW(L"Kernel32.DLL"), "AddDllDirectory")) { - flags_start = 0; - } - /* Iterate through the possible flags and formats. */ - for (cFlag = flags_start; cFlag < 2; cFlag++) - { - for (cFormat = 0; cFormat < 4; cFormat++) - { + HINSTANCE instance; + for (int cFlag = 0; cFlag < 2; cFlag++) { + for (int cFormat = 0; cFormat < 4; cFormat++) { snwprintf(buf, bufsize, formats[cFormat], dll_name); instance = LoadLibraryExW(buf, NULL, flags[cFlag]); if (instance == NULL) { - if (GetLastError() != ERROR_MOD_NOT_FOUND) - { + if (GetLastError() != ERROR_MOD_NOT_FOUND) { goto error; } - } - else - { + } else { break; /* We're done. DLL has been loaded. */ } } @@ -855,6 +889,7 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) goto error; } + addLoadedDll(&loaded_dll_set, dll_name); addDLLHandle(buf, instance); if (loaded) { *loaded = instance; @@ -1658,7 +1693,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) } addSection(section, kind, SECTION_NOMEM, start, sz, 0, 0, 0); - addProddableBlock(oc, oc->sections[i].start, sz); + addProddableBlock(&oc->proddables, oc->sections[i].start, sz); } /* Copy exported symbols into the ObjectCode. */ @@ -1690,7 +1725,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) SECTIONKIND_RWDATA, SECTION_MALLOC, bss, globalBssSize, 0, 0, 0); IF_DEBUG(linker_verbose, debugBelch("bss @ %p %" FMT_Word "\n", bss, globalBssSize)); - addProddableBlock(oc, bss, globalBssSize); + addProddableBlock(&oc->proddables, bss, globalBssSize); } else { addSection(&oc->sections[oc->n_sections-1], SECTIONKIND_OTHER, SECTION_NOMEM, NULL, 0, 0, 0, 0); @@ -2067,13 +2102,13 @@ ocResolve_PEi386 ( ObjectCode* oc ) IF_DEBUG(linker_verbose, debugBelch("S=%zx\n", S)); /* All supported relocations write at least 4 bytes */ - checkProddableBlock(oc, pP, 4); + checkProddableBlock(&oc->proddables, pP, 4); switch (reloc->Type) { #if defined(x86_64_HOST_ARCH) case 1: /* R_X86_64_64 (ELF constant 1) - IMAGE_REL_AMD64_ADDR64 (PE constant 1) */ { uint64_t A; - checkProddableBlock(oc, pP, 8); + checkProddableBlock(&oc->proddables, pP, 8); A = *(uint64_t*)pP; *(uint64_t *)pP = S + A; break; @@ -2114,7 +2149,7 @@ ocResolve_PEi386 ( ObjectCode* oc ) { /* mingw will emit this for a pc-rel 64 relocation */ uint64_t A; - checkProddableBlock(oc, pP, 8); + checkProddableBlock(&oc->proddables, pP, 8); A = *(uint64_t*)pP; *(uint64_t *)pP = S + A - (intptr_t)pP; break; ===================================== rts/linker/ProddableBlocks.c ===================================== @@ -0,0 +1,130 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2025 + * + * RTS Object Linker + * + * ---------------------------------------------------------------------------*/ + + +/* + * Sanity checking. For each ObjectCode, maintain a list of address ranges + * which may be prodded during relocation, and abort if we try and write + * outside any of these. + */ + +#include "Rts.h" +#include "RtsUtils.h" +#include "linker/ProddableBlocks.h" + +#include <stdlib.h> +#include <string.h> + +typedef struct _ProddableBlock { + uintptr_t start; // inclusive + uintptr_t end; // inclusive +} ProddableBlock; + +void +initProddableBlockSet ( ProddableBlockSet* set ) +{ + set->data = NULL; + set->capacity = 0; + set->size = 0; +} + +void +freeProddableBlocks (ProddableBlockSet *set) +{ + stgFree(set->data); + set->data = NULL; + set->size = 0; + set->capacity = 0; +} + +// Binary search for the first interval with start >= value. Returns index or +// size if none. +static size_t +findLower(const ProddableBlockSet *set, uintptr_t value) +{ + size_t l = 0; + size_t r = set->size; + while (l < r) { + size_t mid = l + (r - l) / 2; + if (set->data[mid].start < value) { + l = mid + 1; + } else { + r = mid; + } + } + return l; +} + +// Check whether a given value is a member of the set. +bool +containsSpan ( const ProddableBlockSet *set, uintptr_t start, uintptr_t end ) +{ + size_t i = findLower(set, start+1); + return i > 0 + && set->data[i-1].start <= start + && end <= set->data[i-1].end; +} + +void +checkProddableBlock (const ProddableBlockSet *set, void *addr, size_t size ) +{ + if (! containsSpan(set, (uintptr_t) addr, (uintptr_t) addr+size)) { + barf("checkProddableBlock: invalid fixup in runtime linker: %p", addr); + } +} + +// Ensure capacity for at least new_capacity intervals +static void +ensureCapacity(ProddableBlockSet *set, size_t new_capacity) { + if (new_capacity > set->capacity) { + size_t cap = set->capacity ? set->capacity * 2 : 4; + if (cap < new_capacity) { + cap = new_capacity; + } + ProddableBlock *tmp = stgReallocBytes(set->data, cap * sizeof(ProddableBlock), "addProddableBlock"); + set->data = tmp; + set->capacity = cap; + } +} + +void +addProddableBlock ( ProddableBlockSet* set, void* start_ptr, size_t size ) +{ + const uintptr_t start = (uintptr_t) start_ptr; + const uintptr_t end = (uintptr_t) start + size; + size_t i = findLower(set, start); + + // check previous interval if it is overlapping or adjacent + if (i > 0 && start <= set->data[i-1].end + 1) { + // merge with left interval + i--; + if (end > set->data[i].end) { + set->data[i].end = end; + } + } else { + // insert new interval + ensureCapacity(set, set->size + 1); + memmove(&set->data[i+1], &set->data[i], sizeof(ProddableBlock) * (set->size - i)); + set->data[i].start = start; + set->data[i].end = end; + set->size++; + } + + // coalesce overlaps on right + size_t j = i; + while (j < set->size && set->data[j].start <= set->data[i].end + 1) { + set->data[i].end = set->data[j].end; + j++; + } + + if (j != i) { + memmove(&set->data[i+1], &set->data[j], sizeof(ProddableBlock) * (set->size - j)); + set->size -= j - i - 1; + } +} + ===================================== rts/linker/ProddableBlocks.h ===================================== @@ -0,0 +1,38 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2025 + * + * RTS Object Linker + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include <stdbool.h> +#include <stddef.h> +#include <stdint.h> + +// An interval set on uintptr_t. +struct _ProddableBlock; + +typedef struct { + size_t size; + size_t capacity; + // sorted list of disjoint (start,end) pairs + struct _ProddableBlock *data; +} ProddableBlockSet; + +void initProddableBlockSet ( ProddableBlockSet* set ); + +// Insert an interval. +void addProddableBlock ( ProddableBlockSet* set, void* start, size_t size ); + +// Check that an address belongs to the set. +void checkProddableBlock (const ProddableBlockSet *set, void *addr, size_t size ); + + +// Free a set. +void freeProddableBlocks (ProddableBlockSet *set); + +// For testing. +bool containsSpan ( const ProddableBlockSet *set, uintptr_t start, uintptr_t end ); ===================================== rts/rts.cabal ===================================== @@ -491,6 +491,7 @@ library linker/MachO.c linker/macho/plt.c linker/macho/plt_aarch64.c + linker/ProddableBlocks.c linker/PEi386.c linker/SymbolExtras.c linker/elf_got.c ===================================== testsuite/tests/rts/TestProddableBlockSet.c ===================================== @@ -0,0 +1,33 @@ +#include <assert.h> +#include <stdbool.h> +#include <stdint.h> +#include <stddef.h> + +// Excerpted from ProddableBlocks.h +typedef struct { + size_t size; + size_t capacity; + // sorted list of disjoint (start,end) pairs + struct _ProddableBlock *data; +} ProddableBlockSet; + +void initProddableBlockSet ( ProddableBlockSet* set ); +void addProddableBlock ( ProddableBlockSet* set, void* start, size_t size ); +bool containsSpan ( const ProddableBlockSet *set, uintptr_t start, uintptr_t end ); + +int main () { + ProddableBlockSet set; + initProddableBlockSet(&set); + addProddableBlock(&set, (void*) 0x20, 0x10); + addProddableBlock(&set, (void*) 0x30, 0x10); + addProddableBlock(&set, (void*) 0x100, 0x10); + + assert( containsSpan(&set, 0x20, 0x30)); + assert( containsSpan(&set, 0x30, 0x29)); + assert(!containsSpan(&set, 0x30, 0x49)); + assert(!containsSpan(&set, 0x60, 0x70)); + assert(!containsSpan(&set, 0x90, 0x110)); + assert( containsSpan(&set, 0x100, 0x101)); + return 0; +} + ===================================== testsuite/tests/rts/all.T ===================================== @@ -641,3 +641,5 @@ test('T25280', [unless(opsys('linux'),skip),req_process,js_skip], compile_and_ru # N.B. This will likely issue a warning on stderr but we merely care that the # program doesn't crash. test('T25560', [req_c_rts, ignore_stderr], compile_and_run, ['']) + +test('TestProddableBlockSet', [req_c_rts], multimod_compile_and_run, ['TestProddableBlockSet.c', '-no-hs-main']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af7b73daab5d9c6b3064d3ae9d82c6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af7b73daab5d9c6b3064d3ae9d82c6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26009] 2 commits: rts/linker/PEi386: Don't repeated load DLLs
by Ben Gamari (＠bgamari) 19 May '25

19 May '25

Ben Gamari pushed to branch wip/T26009 at Glasgow Haskell Compiler / GHC Commits: 7973f903 by Ben Gamari at 2025-05-19T15:34:19-04:00 rts/linker/PEi386: Don't repeated load DLLs Previously every DLL-imported symbol would result in a call to `LoadLibraryEx`. This ended up constituting over 40% of the runtime of `ghc --interactive -e 42` on Windows. Avoid this by maintaining a hash-set of loaded DLL names, skipping the call if we have already loaded the requested DLL. Addresses #26009. - - - - - af7b73da by Ben Gamari at 2025-05-19T15:39:26-04:00 fixup! rts/Hash: Factor out hashBuffer - - - - - 3 changed files: - rts/Hash.c - rts/Hash.h - rts/linker/PEi386.c Changes: ===================================== rts/Hash.c ===================================== @@ -94,9 +94,9 @@ hashWord(const HashTable *table, StgWord key) } int -hashBuffer(const void *buf, size_t len) +hashBuffer(const HashTable *table, const void *buf, size_t len) { - const char *key = (char*) w; + const char *key = (char*) buf; #if WORD_SIZE_IN_BITS == 64 StgWord h = XXH3_64bits_withSeed (key, strlen(key), 1048583); #else @@ -117,7 +117,7 @@ hashBuffer(const void *buf, size_t len) int hashStr(const HashTable *table, StgWord w) { - return hashBuffer(key, strlen(key)); + return hashBuffer(table, key, strlen(key)); } STATIC_INLINE int ===================================== rts/Hash.h ===================================== @@ -71,7 +71,7 @@ typedef int HashFunction(const HashTable *table, StgWord key); typedef int CompareFunction(StgWord key1, StgWord key2); // Helper for implementing hash functions -int hashBuffer(const void *buf, size_t len); +int hashBuffer(const HashTable *table, const void *buf, size_t len); int hashWord(const HashTable *table, StgWord key); int hashStr(const HashTable *table, StgWord w); ===================================== rts/linker/PEi386.c ===================================== @@ -427,8 +427,53 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; +/* + * Note [Avoiding repeated DLL loading] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * As LoadLibraryEx tends to be expensive and addDLL_PEi386 is called on every + * DLL-imported symbol, we use a hash-set to keep track of which DLLs have + * already been loaded. This hash-set is keyed on the dll_name passed to + * addDLL_PEi386 and serves as a quick check to avoid repeated calls to + * LoadLibraryEx for the identical DLL. See #26009. + */ + +typedef struct { + HashTable *hash; +} LoadedDllSet; + +LoadedDllSet loaded_dll_set; + +void initLoadedDllSet(LoadedDllSet *set) { + set->hash = allocHashTable(); +} + +int hash_path(const HashTable *table, StgWord key) +{ + const pathchar *key = (pathchar*) w; + return hashBuffer(table, key, sizeof(pathchar) * wcslen(key)); +} + +int compare_path(StgWord key1, StgWord key2) +{ + return wscmp((pathchar*) key1, (pathchar*) key2); +} + +void addLoadedDll(LoadedDllSet *set, pathchar *dll_name) +{ + insertHashTable_(set->hash, (StgWord) dll_name, (void*) 1, hash_path); +} + +bool isDllLoaded(LoadedDllSet *set, pathchar *dll_name) +{ + void * result = lookupHashTable_(set->hash, (StgWord) dll_name, hash_path, compare_path); + return result != NULL; +} + + void initLinker_PEi386(void) { + initLoadedDllSet(&loaded_dll_set); + if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), symhash, "__image_base__", GetModuleHandleW (NULL), HS_BOOL_TRUE, @@ -802,6 +847,10 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) /* ------------------- Win32 DLL loader ------------------- */ IF_DEBUG(linker, debugBelch("addDLL; dll_name = `%" PATH_FMT "'\n", dll_name)); + if (isDllLoaded(loaded_dll_set, dll_name)) { + return NULL; + } + /* The file name has no suffix (yet) so that we can try both foo.dll and foo.drv @@ -840,6 +889,7 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) goto error; } + addLoadedDll(&loaded_dll_set, dll_name); addDLLHandle(buf, instance); if (loaded) { *loaded = instance; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/295ed26f4989dbe47b34c1257016c8… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/295ed26f4989dbe47b34c1257016c8… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26009] 6 commits: rts/linker: Improve efficiency of proddable blocks structure
by Ben Gamari (＠bgamari) 19 May '25

19 May '25

Ben Gamari pushed to branch wip/T26009 at Glasgow Haskell Compiler / GHC Commits: 89031e59 by Ben Gamari at 2025-05-19T13:15:37-04:00 rts/linker: Improve efficiency of proddable blocks structure Previously the linker's "proddable blocks" check relied on a simple linked list of spans. This resulted in extremely poor complexity while linking objects with lots of small sections (e.g. objects built with split sections). Rework the mechanism to instead use a simple interval set implemented via binary search. Fixes #26009. - - - - - 3b644180 by Ben Gamari at 2025-05-19T13:51:31-04:00 testsuite: Add simple functional test for ProddableBlockSet - - - - - 525894ab by Ben Gamari at 2025-05-19T14:29:33-04:00 rts/linker/PEi386: Drop check for LOAD_LIBRARY_SEARCH_*_DIRS The `LOAD_LIBRARY_SEARCH_USER_DIRS` and `LOAD_LIBRARY_SEARCH_DEFAULT_DIRS` were introduced in Windows Vista and have been available every since. As we no longer support Windows XP we can drop this check. Addresses #26009. - - - - - b5fc6607 by Ben Gamari at 2025-05-19T15:08:38-04:00 rts/linker/PEi386: Clean up code style - - - - - ff9b8733 by Ben Gamari at 2025-05-19T15:27:52-04:00 rts/Hash: Factor out hashBuffer This is a useful helper which can be used for non-strings as well. - - - - - 295ed26f by Ben Gamari at 2025-05-19T15:28:36-04:00 rts/linker/PEi386: Maintain set of loaded DLLs Addresses #26009. - - - - - 7 changed files: - rts/Hash.c - rts/Hash.h - rts/linker/PEi386.c - rts/linker/ProddableBlocks.c - rts/linker/ProddableBlocks.h - + testsuite/tests/rts/TestProddableBlockSet.c - testsuite/tests/rts/all.T Changes: ===================================== rts/Hash.c ===================================== @@ -94,7 +94,7 @@ hashWord(const HashTable *table, StgWord key) } int -hashStr(const HashTable *table, StgWord w) +hashBuffer(const void *buf, size_t len) { const char *key = (char*) w; #if WORD_SIZE_IN_BITS == 64 @@ -114,6 +114,12 @@ hashStr(const HashTable *table, StgWord w) return bucket; } +int +hashStr(const HashTable *table, StgWord w) +{ + return hashBuffer(key, strlen(key)); +} + STATIC_INLINE int compareWord(StgWord key1, StgWord key2) { ===================================== rts/Hash.h ===================================== @@ -69,6 +69,10 @@ void * removeStrHashTable ( StrHashTable *table, const char * key, */ typedef int HashFunction(const HashTable *table, StgWord key); typedef int CompareFunction(StgWord key1, StgWord key2); + +// Helper for implementing hash functions +int hashBuffer(const void *buf, size_t len); + int hashWord(const HashTable *table, StgWord key); int hashStr(const HashTable *table, StgWord w); void insertHashTable_ ( HashTable *table, StgWord key, @@ -79,6 +83,7 @@ void * removeHashTable_ ( HashTable *table, StgWord key, const void *data, HashFunction f, CompareFunction cmp ); + /* Freeing hash tables */ void freeHashTable ( HashTable *table, void (*freeDataFun)(void *) ); ===================================== rts/linker/PEi386.c ===================================== @@ -427,8 +427,53 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; +/* + * Note [Avoiding repeated DLL loading] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * As LoadLibraryEx tends to be expensive and addDLL_PEi386 is called on every + * DLL-imported symbol, we use a hash-set to keep track of which DLLs have + * already been loaded. This hash-set is keyed on the dll_name passed to + * addDLL_PEi386 and serves as a quick check to avoid repeated calls to + * LoadLibraryEx for the identical DLL. See #26009. + */ + +typedef struct { + HashTable *hash; +} LoadedDllSet; + +LoadedDllSet loaded_dll_set; + +void initLoadedDllSet(LoadedDllSet *set) { + set->hash = allocHashTable(); +} + +int hash_path(const HashTable *table, StgWord key) +{ + const pathchar *key = (pathchar*) w; + return hashBuffer(key, sizeof(pathchar) * wcslen(key)); +} + +int compare_path(StgWord key1, StgWord key2) +{ + return wscmp((pathchar*) key1, (pathchar*) key2); +} + +void addLoadedDll(LoadedDllSet *set, pathchar *dll_name) +{ + insertHashTable_(set->hash, (StgWord) dll_name, (void*) 1, hash_path); +} + +bool isDllLoaded(LoadedDllSet *set, pathchar *dll_name) +{ + void * result = lookupHashTable_(set->hash, (StgWord) dll_name, hash_path, compare_path); + return result != NULL; +} + + void initLinker_PEi386(void) { + initLoadedDllSet(&loaded_dll_set); + if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), symhash, "__image_base__", GetModuleHandleW (NULL), HS_BOOL_TRUE, @@ -440,10 +485,11 @@ void initLinker_PEi386(void) addDLLHandle(WSTR("*.exe"), GetModuleHandle(NULL)); #endif - /* Register the cleanup routine as an exit handler, this gives other exit handlers - a chance to run which may need linker information. Exit handlers are ran in - reverse registration order so this needs to be before the linker loads anything. */ - atexit (exitLinker_PEi386); + /* Register the cleanup routine as an exit handler, this gives other exit handlers + * a chance to run which may need linker information. Exit handlers are ran in + * reverse registration order so this needs to be before the linker loads anything. + */ + atexit (exitLinker_PEi386); } void exitLinker_PEi386(void) @@ -798,12 +844,12 @@ uint8_t* getSymShortName ( COFF_HEADER_INFO *info, COFF_symbol* sym ) const char * addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) { - /* ------------------- Win32 DLL loader ------------------- */ - - pathchar* buf; - HINSTANCE instance; + /* ------------------- Win32 DLL loader ------------------- */ + IF_DEBUG(linker, debugBelch("addDLL; dll_name = `%" PATH_FMT "'\n", dll_name)); - IF_DEBUG(linker, debugBelch("addDLL; dll_name = `%" PATH_FMT "'\n", dll_name)); + if (isDllLoaded(loaded_dll_set)) { + return NULL; + } /* The file name has no suffix (yet) so that we can try both foo.dll and foo.drv @@ -816,35 +862,23 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) extension. */ size_t bufsize = pathlen(dll_name) + 10; - buf = stgMallocBytes(bufsize * sizeof(wchar_t), "addDLL"); + pathchar *buf = stgMallocBytes(bufsize * sizeof(wchar_t), "addDLL"); /* These are ordered by probability of success and order we'd like them. */ const wchar_t *formats[] = { L"%ls.DLL", L"%ls.DRV", L"lib%ls.DLL", L"%ls" }; const DWORD flags[] = { LOAD_LIBRARY_SEARCH_USER_DIRS | LOAD_LIBRARY_SEARCH_DEFAULT_DIRS, 0 }; - int cFormat, cFlag; - int flags_start = 1; /* Assume we don't support the new API. */ - - /* Detect if newer API are available, if not, skip the first flags entry. */ - if (GetProcAddress((HMODULE)LoadLibraryW(L"Kernel32.DLL"), "AddDllDirectory")) { - flags_start = 0; - } - /* Iterate through the possible flags and formats. */ - for (cFlag = flags_start; cFlag < 2; cFlag++) - { - for (cFormat = 0; cFormat < 4; cFormat++) - { + HINSTANCE instance; + for (int cFlag = 0; cFlag < 2; cFlag++) { + for (int cFormat = 0; cFormat < 4; cFormat++) { snwprintf(buf, bufsize, formats[cFormat], dll_name); instance = LoadLibraryExW(buf, NULL, flags[cFlag]); if (instance == NULL) { - if (GetLastError() != ERROR_MOD_NOT_FOUND) - { + if (GetLastError() != ERROR_MOD_NOT_FOUND) { goto error; } - } - else - { + } else { break; /* We're done. DLL has been loaded. */ } } @@ -855,6 +889,7 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) goto error; } + addLoadedDll(&loaded_dll_set, dll_name); addDLLHandle(buf, instance); if (loaded) { *loaded = instance; ===================================== rts/linker/ProddableBlocks.c ===================================== @@ -6,65 +6,125 @@ * * ---------------------------------------------------------------------------*/ + +/* + * Sanity checking. For each ObjectCode, maintain a list of address ranges + * which may be prodded during relocation, and abort if we try and write + * outside any of these. + */ + #include "Rts.h" #include "RtsUtils.h" #include "linker/ProddableBlocks.h" -struct _ProddableBlock { - void* start; - int size; - struct _ProddableBlock* next; -}; +#include <stdlib.h> +#include <string.h> -typedef struct _ProddableBlock ProddableBlock; +typedef struct _ProddableBlock { + uintptr_t start; // inclusive + uintptr_t end; // inclusive +} ProddableBlock; void initProddableBlockSet ( ProddableBlockSet* set ) { - set->head = NULL; + set->data = NULL; + set->capacity = 0; + set->size = 0; } -/* ----------------------------------------------------------------------------- - * Sanity checking. For each ObjectCode, maintain a list of address ranges - * which may be prodded during relocation, and abort if we try and write - * outside any of these. - */ void -addProddableBlock ( ProddableBlockSet* set, void* start, int size ) +freeProddableBlocks (ProddableBlockSet *set) +{ + stgFree(set->data); + set->data = NULL; + set->size = 0; + set->capacity = 0; +} + +// Binary search for the first interval with start >= value. Returns index or +// size if none. +static size_t +findLower(const ProddableBlockSet *set, uintptr_t value) { - ProddableBlock* pb = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock"); - - IF_DEBUG(linker, debugBelch("addProddableBlock: %p %d\n", start, size)); - ASSERT(size > 0); - pb->start = start; - pb->size = size; - pb->next = set->head; - set->head = pb; + size_t l = 0; + size_t r = set->size; + while (l < r) { + size_t mid = l + (r - l) / 2; + if (set->data[mid].start < value) { + l = mid + 1; + } else { + r = mid; + } + } + return l; +} + +// Check whether a given value is a member of the set. +bool +containsSpan ( const ProddableBlockSet *set, uintptr_t start, uintptr_t end ) +{ + size_t i = findLower(set, start+1); + return i > 0 + && set->data[i-1].start <= start + && end <= set->data[i-1].end; } void -checkProddableBlock (ProddableBlockSet *set, void *addr, size_t size ) +checkProddableBlock (const ProddableBlockSet *set, void *addr, size_t size ) { - ProddableBlock* pb; - - for (pb = set->head; pb != NULL; pb = pb->next) { - char* s = (char*)(pb->start); - char* e = s + pb->size; - char* a = (char*)addr; - if (a >= s && (a+size) <= e) - return; + if (! containsSpan(set, (uintptr_t) addr, (uintptr_t) addr+size)) { + barf("checkProddableBlock: invalid fixup in runtime linker: %p", addr); } - barf("checkProddableBlock: invalid fixup in runtime linker: %p", addr); } -void freeProddableBlocks (ProddableBlockSet *set) +// Ensure capacity for at least new_capacity intervals +static void +ensureCapacity(ProddableBlockSet *set, size_t new_capacity) { + if (new_capacity > set->capacity) { + size_t cap = set->capacity ? set->capacity * 2 : 4; + if (cap < new_capacity) { + cap = new_capacity; + } + ProddableBlock *tmp = stgReallocBytes(set->data, cap * sizeof(ProddableBlock), "addProddableBlock"); + set->data = tmp; + set->capacity = cap; + } +} + +void +addProddableBlock ( ProddableBlockSet* set, void* start_ptr, size_t size ) { - ProddableBlock *pb, *next; + const uintptr_t start = (uintptr_t) start_ptr; + const uintptr_t end = (uintptr_t) start + size; + size_t i = findLower(set, start); + + // check previous interval if it is overlapping or adjacent + if (i > 0 && start <= set->data[i-1].end + 1) { + // merge with left interval + i--; + if (end > set->data[i].end) { + set->data[i].end = end; + } + } else { + // insert new interval + ensureCapacity(set, set->size + 1); + memmove(&set->data[i+1], &set->data[i], sizeof(ProddableBlock) * (set->size - i)); + set->data[i].start = start; + set->data[i].end = end; + set->size++; + } + + // coalesce overlaps on right + size_t j = i; + while (j < set->size && set->data[j].start <= set->data[i].end + 1) { + set->data[i].end = set->data[j].end; + j++; + } - for (pb = set->head; pb != NULL; pb = next) { - next = pb->next; - stgFree(pb); + if (j != i) { + memmove(&set->data[i+1], &set->data[j], sizeof(ProddableBlock) * (set->size - j)); + set->size -= j - i - 1; } - set->head = NULL; } ===================================== rts/linker/ProddableBlocks.h ===================================== @@ -8,20 +8,31 @@ #pragma once +#include <stdbool.h> +#include <stddef.h> +#include <stdint.h> + // An interval set on uintptr_t. struct _ProddableBlock; typedef struct { - struct _ProddableBlock *head; + size_t size; + size_t capacity; + // sorted list of disjoint (start,end) pairs + struct _ProddableBlock *data; } ProddableBlockSet; void initProddableBlockSet ( ProddableBlockSet* set ); // Insert an interval. -void addProddableBlock ( ProddableBlockSet* set, void* start, int size ); +void addProddableBlock ( ProddableBlockSet* set, void* start, size_t size ); // Check that an address belongs to the set. -void checkProddableBlock (ProddableBlockSet *set, void *addr, size_t size ); +void checkProddableBlock (const ProddableBlockSet *set, void *addr, size_t size ); + // Free a set. void freeProddableBlocks (ProddableBlockSet *set); + +// For testing. +bool containsSpan ( const ProddableBlockSet *set, uintptr_t start, uintptr_t end ); ===================================== testsuite/tests/rts/TestProddableBlockSet.c ===================================== @@ -0,0 +1,33 @@ +#include <assert.h> +#include <stdbool.h> +#include <stdint.h> +#include <stddef.h> + +// Excerpted from ProddableBlocks.h +typedef struct { + size_t size; + size_t capacity; + // sorted list of disjoint (start,end) pairs + struct _ProddableBlock *data; +} ProddableBlockSet; + +void initProddableBlockSet ( ProddableBlockSet* set ); +void addProddableBlock ( ProddableBlockSet* set, void* start, size_t size ); +bool containsSpan ( const ProddableBlockSet *set, uintptr_t start, uintptr_t end ); + +int main () { + ProddableBlockSet set; + initProddableBlockSet(&set); + addProddableBlock(&set, (void*) 0x20, 0x10); + addProddableBlock(&set, (void*) 0x30, 0x10); + addProddableBlock(&set, (void*) 0x100, 0x10); + + assert( containsSpan(&set, 0x20, 0x30)); + assert( containsSpan(&set, 0x30, 0x29)); + assert(!containsSpan(&set, 0x30, 0x49)); + assert(!containsSpan(&set, 0x60, 0x70)); + assert(!containsSpan(&set, 0x90, 0x110)); + assert( containsSpan(&set, 0x100, 0x101)); + return 0; +} + ===================================== testsuite/tests/rts/all.T ===================================== @@ -641,3 +641,5 @@ test('T25280', [unless(opsys('linux'),skip),req_process,js_skip], compile_and_ru # N.B. This will likely issue a warning on stderr but we merely care that the # program doesn't crash. test('T25560', [req_c_rts, ignore_stderr], compile_and_run, ['']) + +test('TestProddableBlockSet', [req_c_rts], multimod_compile_and_run, ['TestProddableBlockSet.c', '-no-hs-main']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/998c2117b4429624fd33e5e58548b8… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/998c2117b4429624fd33e5e58548b8… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26003] Track rewriter sets more accurately in constraint solving
by sheaf (＠sheaf) 19 May '25

19 May '25

sheaf pushed to branch wip/T26003 at Glasgow Haskell Compiler / GHC Commits: 98ab1713 by Simon Peyton Jones at 2025-05-19T21:12:55+02:00 Track rewriter sets more accurately in constraint solving This MR addresses #26003, by refactoring the arcane intricacies of Note [Equalities with incompatible kinds]. NB: now retitled to Note [Equalities with heterogeneous kinds]. and the main Note for this MR. In particular: * Abandon invariant (COERCION-HOLE) in Note [Unification preconditions] in GHC.Tc.Utils.Unify. * Abandon invariant (TyEq:CH)) in Note [Canonical equalities] in GHC.Tc.Types.Constraint. * Instead: add invariant (REWRITERS) to Note [Unification preconditions]: unify only if the constraint has an empty rewriter set. Implementation: * In canEqCanLHSFinish_try_unification, skip trying unification if there is a non-empty rewriter set. * To do this, make sure the rewriter set is zonked; do so in selectNextWorkItem, which also deals with prioritisation. * When a coercion hole is filled, kick out inert equalities that have that hole as a rewriter. It might now be unlocked and available to unify. * Remove the ad-hoc `ch_hetero_kind` field of `CoercionHole`. * In `selectNextWorkItem`, priorities equalities withan empty rewriter set. * Defaulting: see (DE6) in Note [Defaulting equalities] and Note [Limited defaulting in the ambiguity check] * Concreteness checks: there is some extra faff to try to get decent error messages when the FRR (representation-polymorphism) checks fail. In partiular, add a "When unifying..." explanation when the representation-polymorphism check arose from another constraint. - - - - - 65 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Plugin.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/dependent/should_fail/T11471.stderr - testsuite/tests/diagnostic-codes/codes.stdout - testsuite/tests/indexed-types/should_fail/T8227.stderr - testsuite/tests/indexed-types/should_fail/T9662.stderr - testsuite/tests/partial-sigs/should_fail/T14040a.stderr - testsuite/tests/partial-sigs/should_fail/T14584.stderr - testsuite/tests/polykinds/T14172.stderr - testsuite/tests/polykinds/T14846.stderr - testsuite/tests/rep-poly/RepPolyArgument.stderr - testsuite/tests/rep-poly/RepPolyBackpack1.stderr - testsuite/tests/rep-poly/RepPolyBinder.stderr - testsuite/tests/rep-poly/RepPolyDoBind.stderr - testsuite/tests/rep-poly/RepPolyDoBody1.stderr - testsuite/tests/rep-poly/RepPolyDoBody2.stderr - testsuite/tests/rep-poly/RepPolyLeftSection2.stderr - testsuite/tests/rep-poly/RepPolyMagic.stderr - testsuite/tests/rep-poly/RepPolyMcBind.stderr - testsuite/tests/rep-poly/RepPolyMcBody.stderr - testsuite/tests/rep-poly/RepPolyMcGuard.stderr - testsuite/tests/rep-poly/RepPolyNPlusK.stderr - testsuite/tests/rep-poly/RepPolyPatBind.stderr - testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr - testsuite/tests/rep-poly/RepPolyRightSection.stderr - testsuite/tests/rep-poly/RepPolyRule1.stderr - testsuite/tests/rep-poly/RepPolyTuple.stderr - testsuite/tests/rep-poly/RepPolyTuple4.stderr - testsuite/tests/rep-poly/RepPolyTupleSection.stderr - testsuite/tests/rep-poly/RepPolyWrappedVar.stderr - testsuite/tests/rep-poly/T11473.stderr - testsuite/tests/rep-poly/T12709.stderr - testsuite/tests/rep-poly/T12973.stderr - testsuite/tests/rep-poly/T13233.stderr - testsuite/tests/rep-poly/T13929.stderr - testsuite/tests/rep-poly/T14561.stderr - testsuite/tests/rep-poly/T14561b.stderr - testsuite/tests/rep-poly/T17817.stderr - testsuite/tests/rep-poly/T19615.stderr - testsuite/tests/rep-poly/T19709b.stderr - testsuite/tests/rep-poly/T21906.stderr - testsuite/tests/rep-poly/T23903.stderr - testsuite/tests/rep-poly/UnliftedNewtypesCoerceFail.stderr - testsuite/tests/typecheck/no_skolem_info/T14040.stderr - testsuite/tests/typecheck/should_compile/T25266a.stderr - testsuite/tests/typecheck/should_fail/T16204c.stderr - testsuite/tests/typecheck/should_fail/T7696.stderr - testsuite/tests/typecheck/should_fail/T8603.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/98ab1713090430cd3740463d2bcfb6e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/98ab1713090430cd3740463d2bcfb6e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/clear-memory-0xaa
by Cheng Shao (＠TerrorJack) 19 May '25

19 May '25

Cheng Shao pushed new branch wip/clear-memory-0xaa at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/clear-memory-0xaa You're receiving this email because of your account on gitlab.haskell.org.

1 0