+hashBuffer(const HashTable *table, const void *buf, size_t len)

+    const char *key = (char*) buf;

+    StgWord h = XXH3_64bits_withSeed (key, len, 1048583);

+    StgWord h = XXH32 (key, len, 1048583);

+int

+hashStr(const HashTable *table, StgWord w)

+{

+    const char *key = (char*) w;

+    return hashBuffer(table, key, strlen(key));

+}

+

+

+// Helper for implementing hash functions

+int hashBuffer(const HashTable *table, const void *buf, size_t len);

+

+

+    freeProddableBlocks(&oc->proddables);

+   initProddableBlockSet(&oc->proddables);

+#include "linker/ProddableBlocks.h"

+    ProddableBlockSet proddables;

+pathchar* pathdup(const pathchar *path)

+pathchar* pathdir(const pathchar *path)

+    // N.B. cast is safe as we do not modify dirName

+    const pathchar* dirName = dirname((pathchar *) path);

+pathchar* mkPath(const char* path)

+HsBool endsWithPath(const pathchar* base, const 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);

+          addProddableBlock(&oc->proddables, start, size);

+       checkProddableBlock ( &oc->proddables, pP, sizeof(Elf_Word) );

+      checkProddableBlock(&oc->proddables, (void*)P, sizeof(Elf_Word));

+        checkProddableBlock(&oc->proddables,

+    checkProddableBlock(&oc->proddables, (void*)p, 1 << ri->r_length);

+    checkProddableBlock(&oc->proddables, (void*)p, 1 << ri->r_length);

+        checkProddableBlock(&oc->proddables,thingPtr,relocLenBytes);

+                checkProddableBlock(&oc->proddables, (void *)((char *)thing + baseValue), 1);

+                checkProddableBlock(&oc->proddables, (void *)thing, 1);

+                addProddableBlock(&oc->proddables, start, section->size);

+    const pathchar* dll_name,

+/*

+ * 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;

+}

+

+    initLoadedDllCache(&loaded_dll_cache);

+

+    /* 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);

+static void addDLLHandle(const pathchar* dll_name, HINSTANCE instance) {

+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) {

+        if (loaded) {

+            *loaded = instance;

+        }

+        return NULL;

+    }

+    pathchar *buf = stgMallocBytes(bufsize * sizeof(wchar_t), "addDLL");

+    for (int cFlag = 0; cFlag < 2; cFlag++) {

+        for (int cFormat = 0; cFormat < 4; cFormat++) {

+                if (GetLastError() != ERROR_MOD_NOT_FOUND) {

+            } else {

+                goto loaded; /* We're done. DLL has been loaded.  */

+    // We failed to load

+    goto error;

+loaded:

+    addLoadedDll(&loaded_dll_cache, dll_name, instance);

+      addProddableBlock(&oc->proddables, oc->sections[i].start, sz);

+       addProddableBlock(&oc->proddables, bss, globalBssSize);

+         checkProddableBlock(&oc->proddables, pP, 4);

+                   checkProddableBlock(&oc->proddables, pP, 8);

+                   checkProddableBlock(&oc->proddables, pP, 8);

+const char * addDLL_PEi386( const pathchar *dll_name, HINSTANCE *instance  );

+/* -----------------------------------------------------------------------------

+ *

+ * (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 <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;

+    }

+}

+

+/* -----------------------------------------------------------------------------

+ *

+ * (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 );

+                 linker/ProddableBlocks.c

+#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);