[Git][ghc/ghc][wip/terrorjack/asan] 7 commits: rts: add ASAN instrumentation to mblock allocator

4 Jul 2026


      Cheng Shao pushed to branch wip/terrorjack/asan at Glasgow Haskell Compiler / GHC


Commits:
bf610931 by Cheng Shao at 2026-07-04T11:31:23+00:00
rts: add ASAN instrumentation to mblock allocator

- - - - -
2dfcb8f1 by Cheng Shao at 2026-07-04T11:32:07+00:00
rts: add ASAN instrumentation to mgroup allocator

- - - - -
a9b83253 by Cheng Shao at 2026-07-04T11:32:43+00:00
rts: add ASAN instrumentation to block allocator

- - - - -
a128cddc by Cheng Shao at 2026-07-04T11:33:18+00:00
rts: add ASAN instrumentation to cap->pinned_object_empty

- - - - -
26da344a by Cheng Shao at 2026-07-04T11:33:47+00:00
rts: add ASAN instrumentation to gc_thread->free_blocks

- - - - -
453c1e8a by Cheng Shao at 2026-07-04T11:34:17+00:00
rts: add ASAN instrumentation to hash table free list

- - - - -
6ba98fc8 by Cheng Shao at 2026-07-04T11:34:46+00:00
rts: add ASAN instrumentation to per-Task InCall free list

- - - - -


9 changed files:

- rts/Hash.c
- rts/Task.c
- rts/include/Stg.h
- + rts/include/rts/ASANUtils.h
- rts/rts.cabal
- rts/sm/BlockAlloc.c
- rts/sm/GCUtils.c
- rts/sm/MBlock.c
- rts/sm/Storage.c


Changes:

=====================================
rts/Hash.c
=====================================
@@ -283,6 +283,7 @@ allocHashList (HashTable *table)
     if (table->freeList != NULL) {
         HashList *hl = table->freeList;
         table->freeList = hl->next;
+        __asan_unpoison_memory_region(hl, offsetof(HashList, next));
         return hl;
     } else {
         /* We allocate one block of memory which contains:
@@ -302,8 +303,11 @@ allocHashList (HashTable *table)
 
         table->freeList = hl + 1;
         HashList *p = table->freeList;
-        for (; p < hl + HCHUNK - 1; p++)
+        for (; p < hl + HCHUNK - 1; p++) {
+            __asan_poison_memory_region(p, offsetof(HashList, next));
             p->next = p + 1;
+        }
+        __asan_poison_memory_region(p, offsetof(HashList, next));
         p->next = NULL;
         return hl;
     }
@@ -318,6 +322,7 @@ freeHashList (HashTable *table, HashList *hl)
     // HashListChunks.
     hl->next = table->freeList;
     table->freeList = hl;
+    __asan_poison_memory_region(hl, offsetof(HashList, next));
 }
 
 STATIC_INLINE void
@@ -388,9 +393,10 @@ removeHashTable_inlined(HashTable *table, StgWord key, const void *data,
                 table->dir[segment][index] = hl->next;
             else
                 prev->next = hl->next;
+            void *hl_data = (void*)hl->data;
             freeHashList(table,hl);
             table->kcount--;
-            return (void *) hl->data;
+            return hl_data;
         }
         prev = hl;
     }


=====================================
rts/Task.c
=====================================
@@ -183,6 +183,7 @@ freeTask (Task *task)
         stgFree(incall);
     }
     for (incall = task->spare_incalls; incall != NULL; incall = next) {
+        __asan_unpoison_memory_region(incall, sizeof(InCall));
         next = incall->next;
         stgFree(incall);
     }
@@ -252,6 +253,7 @@ newInCall (Task *task)
 
     if (task->spare_incalls != NULL) {
         incall = task->spare_incalls;
+        __asan_unpoison_memory_region(incall, sizeof(InCall));
         task->spare_incalls = incall->next;
         task->n_spare_incalls--;
     } else {
@@ -283,6 +285,7 @@ endInCall (Task *task)
         stgFree(incall);
     } else {
         incall->next = task->spare_incalls;
+        __asan_poison_memory_region(incall, sizeof(InCall));
         task->spare_incalls = incall;
         task->n_spare_incalls++;
     }


=====================================
rts/include/Stg.h
=====================================
@@ -331,6 +331,7 @@ external prototype return neither of these types to workaround #11395.
 #include "stg/MachRegsForHost.h"
 #include "stg/Regs.h"
 #include "stg/Ticky.h"
+#include "rts/ASANUtils.h"
 #include "rts/TSANUtils.h"
 
 #if IN_STG_CODE


=====================================
rts/include/rts/ASANUtils.h
=====================================
@@ -0,0 +1,27 @@
+#pragma once
+
+#if defined(__SANITIZE_ADDRESS__)
+#define ASAN_ENABLED
+#elif defined(__has_feature)
+#if __has_feature(address_sanitizer)
+#define ASAN_ENABLED
+#endif
+#endif
+
+#if defined(ASAN_ENABLED)
+#include <sanitizer/asan_interface.h>
+#else
+
+#include <stdlib.h>
+
+static inline void __asan_poison_memory_region(void const volatile *addr
+                                               __attribute__((unused)),
+                                               size_t size
+                                               __attribute__((unused))) {}
+
+static inline void __asan_unpoison_memory_region(void const volatile *addr
+                                                 __attribute__((unused)),
+                                                 size_t size
+                                                 __attribute__((unused))) {}
+
+#endif


=====================================
rts/rts.cabal
=====================================
@@ -292,6 +292,7 @@ library
                         -- ^ generated
                         rts/ghc_ffi.h
                         rts/Adjustor.h
+                        rts/ASANUtils.h
                         rts/ExecPage.h
                         rts/BlockSignals.h
                         rts/Bytecodes.h


=====================================
rts/sm/BlockAlloc.c
=====================================
@@ -261,6 +261,8 @@ initGroup(bdescr *head)
       head[i].flags = 0;
   }
 #endif
+
+  __asan_unpoison_memory_region(head->start, (W_)head->blocks * BLOCK_SIZE);
 }
 
 #if SIZEOF_VOID_P == SIZEOF_LONG
@@ -474,6 +476,7 @@ alloc_mega_group (uint32_t node, StgWord mblocks)
         bd = alloc_mega_group_from_free_list(&deferred_free_mblock_list[node], n, &best);
         if(bd)
         {
+            __asan_unpoison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE);
             return bd;
         }
         else if(!best)
@@ -490,6 +493,7 @@ alloc_mega_group (uint32_t node, StgWord mblocks)
 
     if (bd)
     {
+        __asan_unpoison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE);
         return bd;
     }
     else if (best)
@@ -500,6 +504,7 @@ alloc_mega_group (uint32_t node, StgWord mblocks)
                           (best_mblocks-mblocks)*MBLOCK_SIZE);
 
         best->blocks = MBLOCK_GROUP_BLOCKS(best_mblocks - mblocks);
+        __asan_unpoison_memory_region(MBLOCK_ROUND_DOWN(bd), mblocks * MBLOCK_SIZE);
         initMBlock(MBLOCK_ROUND_DOWN(bd), node);
     }
     else
@@ -880,6 +885,8 @@ free_mega_group (bdescr *mg)
 
         IF_DEBUG(sanity, checkFreeListSanity());
     }
+
+    __asan_poison_memory_region(mg->start, (W_)mg->blocks * BLOCK_SIZE);
 }
 
 static void
@@ -927,6 +934,8 @@ free_deferred_mega_groups (uint32_t node)
         // coalesce forwards
         coalesce_mblocks(mg);
 
+        __asan_poison_memory_region(mg->start, (W_)mg->blocks * BLOCK_SIZE);
+
         // initialize search for next round
         prev = mg;
         bd = prev->link;
@@ -1050,6 +1059,8 @@ freeGroup(bdescr *p)
   setup_tail(p);
   free_list_insert(node,p);
 
+  __asan_poison_memory_region(p->start, (W_)p->blocks * BLOCK_SIZE);
+
   IF_DEBUG(sanity, checkFreeListSanity());
 }
 


=====================================
rts/sm/GCUtils.c
=====================================
@@ -348,6 +348,7 @@ alloc_todo_block (gen_workspace *ws, uint32_t size)
         } else {
             if (gct->free_blocks) {
                 bd = gct->free_blocks;
+                __asan_unpoison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE);
                 gct->free_blocks = bd->link;
             } else {
                 // We allocate in chunks of at most 16 blocks, use one
@@ -357,6 +358,9 @@ alloc_todo_block (gen_workspace *ws, uint32_t size)
                 StgWord n_blocks = stg_min(chunk_size, 1 << (MBLOCK_SHIFT - BLOCK_SHIFT - 1));
                 allocBlocks_sync(n_blocks, &bd);
                 gct->free_blocks = bd->link;
+                for (bdescr *bd = gct->free_blocks; bd; bd = bd->link) {
+                    __asan_poison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE);
+                }
             }
         }
         initBdescr(bd, ws->gen, ws->gen->to);


=====================================
rts/sm/MBlock.c
=====================================
@@ -641,6 +641,8 @@ getMBlocks(uint32_t n)
 
     ret = getCommittedMBlocks(n);
 
+    __asan_unpoison_memory_region(ret, (W_)n * MBLOCK_SIZE);
+
     debugTrace(DEBUG_gc, "allocated %d megablock(s) at %p",n,ret);
 
     mblocks_allocated += n;
@@ -673,6 +675,8 @@ freeMBlocks(void *addr, uint32_t n)
 
     mblocks_allocated -= n;
 
+    __asan_poison_memory_region(addr, (W_)n * MBLOCK_SIZE);
+
     decommitMBlocks(addr, n);
 }
 


=====================================
rts/sm/Storage.c
=====================================
@@ -1242,6 +1242,10 @@ start_new_pinned_block(Capability *cap)
         ACQUIRE_SM_LOCK;
         bd = allocNursery(cap->node, NULL, PINNED_EMPTY_SIZE);
         RELEASE_SM_LOCK;
+
+        for (bdescr *pbd = bd; pbd; pbd = pbd->link) {
+            __asan_poison_memory_region(pbd->start, (W_)pbd->blocks * BLOCK_SIZE);
+        }
     }
 
     // Bump up the nursery pointer to avoid the pathological situation
@@ -1267,6 +1271,7 @@ start_new_pinned_block(Capability *cap)
     }
 
     cap->pinned_object_empty = bd->link;
+    __asan_unpoison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE);
     newNurseryBlock(bd);
     if (bd->link != NULL) {
       bd->link->u.back = cap->pinned_object_empty;



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3bf823fb975a1e7535d00b89ce5aa93...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3bf823fb975a1e7535d00b89ce5aa93...
You're receiving this email because of your account on gitlab.haskell.org.

    

Cheng Shao (＠TerrorJack)

tags

participants (1)