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 +#include -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 +#include +#include + // 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 +#include +#include +#include + +// 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/998c2117b4429624fd33e5e58548b8b... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/998c2117b4429624fd33e5e58548b8b... You're receiving this email because of your account on gitlab.haskell.org.