Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3f4b823c by Ben Gamari at 2025-05-23T03:43:28-04:00 rts/linker: Factor out ProddableBlocks machinery - - - - - 6e23fef2 by Ben Gamari at 2025-05-23T03:43:28-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. - - - - - ea74860c by Ben Gamari at 2025-05-23T03:43:28-04:00 testsuite: Add simple functional test for ProddableBlockSet - - - - - 74c4db46 by Ben Gamari at 2025-05-23T03:43:28-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. - - - - - 972d81d6 by Ben Gamari at 2025-05-23T03:43:28-04:00 rts/linker/PEi386: Clean up code style - - - - - 8a1073a5 by Ben Gamari at 2025-05-23T03:43:28-04:00 rts/Hash: Factor out hashBuffer This is a useful helper which can be used for non-strings as well. - - - - - 44f509f2 by Ben Gamari at 2025-05-23T03:43:28-04:00 rts/linker/PEi386: Fix incorrect use of break in nested for Previously the happy path of PEi386 used `break` in a double-`for` loop resulting in redundant calls to `LoadLibraryEx`. Fixes #26052. - - - - - bfb12783 by Ben Gamari at 2025-05-23T03:43:28-04:00 rts: Correctly mark const arguments - - - - - 08469ff8 by Ben Gamari at 2025-05-23T03:43:28-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. - - - - - 823d1ccf by Ben Gamari at 2025-05-23T03:43:28-04:00 rts/linker: Expand comment describing ProddableBlockSet - - - - - 15 changed files: - rts/Hash.c - rts/Hash.h - rts/Linker.c - rts/LinkerInternals.h - rts/PathUtils.c - rts/PathUtils.h - rts/linker/Elf.c - rts/linker/MachO.c - rts/linker/PEi386.c - rts/linker/PEi386.h - + rts/linker/ProddableBlocks.c - + rts/linker/ProddableBlocks.h - rts/rts.cabal - + testsuite/tests/rts/TestProddableBlockSet.c - testsuite/tests/rts/all.T 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.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 @@ -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/PathUtils.c ===================================== @@ -13,7 +13,7 @@ #include #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) @@ -40,7 +40,8 @@ pathchar* pathdir(pathchar *path) stgFree(drive); stgFree(dirName); #else - pathchar* dirName = dirname(path); + // N.B. cast is safe as we do not modify dirName + const pathchar* dirName = dirname((pathchar *) path); size_t memberLen = pathlen(dirName); ret = stgMallocBytes(pathsize * (memberLen + 2), "pathdir(path)"); strcpy(ret, dirName); @@ -50,7 +51,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 +67,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); +pathchar* 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" ===================================== 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 ===================================== @@ -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) == 0; +} + +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, @@ -440,10 +484,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) @@ -454,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. @@ -796,14 +841,19 @@ 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 ------------------- */ - - pathchar* buf; - HINSTANCE instance; - - IF_DEBUG(linker, debugBelch("addDLL; dll_name = `%" PATH_FMT "'\n", dll_name)); + /* ------------------- 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) { + if (loaded) { + *loaded = instance; + } + return NULL; + } /* The file name has no suffix (yet) so that we can try both foo.dll and foo.drv @@ -816,45 +866,32 @@ 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++) - { + 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 - { - break; /* We're done. DLL has been loaded. */ + } else { + goto loaded; /* We're done. DLL has been loaded. */ } } } - /* Check if we managed to load the DLL. */ - if (instance == NULL) { - goto error; - } + // We failed to load + goto error; +loaded: + addLoadedDll(&loaded_dll_cache, dll_name, instance); addDLLHandle(buf, instance); if (loaded) { *loaded = instance; @@ -1658,7 +1695,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 +1727,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 +2104,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 +2151,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/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); ===================================== rts/linker/ProddableBlocks.c ===================================== @@ -0,0 +1,137 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2025 + * + * RTS Object Linker + * + * ---------------------------------------------------------------------------*/ + + +/* + * Note [Proddable blocks] + * ~~~~~~~~~~~~~~~~~~~~~~~ + * For each ObjectCode, we maintain a ProddableBlockSet representing the set of + * address ranges containing data belonging to the object. This set is + * represented here as an array of intervals sorted by start address. This + * allows us to efficiently query and insert via binary search. Array resizing + * is done according to an exponential growth schedule. + * + * While performing relocations we check against this set and and abort if we + * try and write outside any of these. + */ + +#include "Rts.h" +#include "RtsUtils.h" +#include "linker/ProddableBlocks.h" + +#include +#include + +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 +#include +#include + +// 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 +#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/7722232c6f8f0b57db03d0439d77896... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7722232c6f8f0b57db03d0439d77896... You're receiving this email because of your account on gitlab.haskell.org.