Cheng Shao pushed to branch wip/terrorjack/asan at Glasgow Haskell Compiler / GHC Commits: d80037c2 by Cheng Shao at 2026-07-06T08:10:12+00:00 rts: add ASAN instrumentation to mblock allocator - - - - - b7450c9d by Cheng Shao at 2026-07-06T08:10:17+00:00 rts: add ASAN instrumentation to mgroup allocator - - - - - 6cf654e3 by Cheng Shao at 2026-07-06T08:10:17+00:00 rts: add ASAN instrumentation to block allocator - - - - - 709b95b5 by Cheng Shao at 2026-07-06T08:10:17+00:00 rts: add ASAN instrumentation to cap->pinned_object_empty - - - - - 5ca629c5 by Cheng Shao at 2026-07-06T08:10:17+00:00 rts: add ASAN instrumentation to gc_thread->free_blocks - - - - - 2ad71829 by Cheng Shao at 2026-07-06T08:10:17+00:00 rts: add ASAN instrumentation to hash table free list - - - - - 73ce0ca8 by Cheng Shao at 2026-07-06T08:10:17+00:00 rts: add ASAN instrumentation to per-Task InCall free list - - - - - a79ae1c7 by Cheng Shao at 2026-07-06T08:10:17+00:00 rts: add ASAN instrumentation to nonmoving allocator - - - - - 12 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/NonMoving.c - rts/sm/NonMovingAllocate.c - rts/sm/NonMovingSweep.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 <stddef.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 ===================================== @@ -241,6 +241,9 @@ tail_of (bdescr *bd) STATIC_INLINE void initGroup(bdescr *head) { + __asan_unpoison_memory_region(head, + stg_min((W_)head->blocks, (W_)BLOCKS_PER_MBLOCK) * sizeof(bdescr)); + head->free = head->start; head->link = NULL; @@ -261,6 +264,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 @@ -308,6 +313,7 @@ setup_tail (bdescr *bd) bdescr *tail; tail = tail_of(bd); if (tail != bd) { + __asan_unpoison_memory_region(tail, sizeof(bdescr)); tail->blocks = 0; tail->free = 0; tail->link = bd; @@ -325,6 +331,7 @@ split_free_block (bdescr *bd, uint32_t node, W_ n, uint32_t ln /* log_2_ceil(n) ASSERT(bd->blocks > n); dbl_link_remove(bd, &free_list[node][ln]); fg = bd + bd->blocks - n; // take n blocks off the end + __asan_unpoison_memory_region(fg, sizeof(bdescr)); fg->blocks = n; bd->blocks -= n; setup_tail(bd); @@ -474,6 +481,8 @@ 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(MBLOCK_ROUND_DOWN(bd), FIRST_BLOCK_OFF); + __asan_unpoison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE); return bd; } else if(!best) @@ -490,6 +499,8 @@ alloc_mega_group (uint32_t node, StgWord mblocks) if (bd) { + __asan_unpoison_memory_region(MBLOCK_ROUND_DOWN(bd), FIRST_BLOCK_OFF); + __asan_unpoison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE); return bd; } else if (best) @@ -500,6 +511,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 +892,11 @@ free_mega_group (bdescr *mg) IF_DEBUG(sanity, checkFreeListSanity()); } + + __asan_poison_memory_region(mg->start, (W_)mg->blocks * BLOCK_SIZE); + // Only the head bdescr of a free mega group carries meaning; poison the + // rest of the first mblock's descriptor area. + __asan_poison_memory_region(mg + 1, ((W_)BLOCKS_PER_MBLOCK - 1) * sizeof(bdescr)); } static void @@ -927,6 +944,9 @@ free_deferred_mega_groups (uint32_t node) // coalesce forwards coalesce_mblocks(mg); + __asan_poison_memory_region(mg->start, (W_)mg->blocks * BLOCK_SIZE); + __asan_poison_memory_region(mg + 1, ((W_)BLOCKS_PER_MBLOCK - 1) * sizeof(bdescr)); + // initialize search for next round prev = mg; bd = prev->link; @@ -979,7 +999,9 @@ freeGroup(bdescr *p) RELAXED_STORE(&p->gen, NULL); RELAXED_STORE(&p->gen_no, 0); /* fill the block group with garbage if sanity checking is on */ - IF_DEBUG(zero_on_gc, memset(p->start, 0xaa, (W_)p->blocks * BLOCK_SIZE)); + IF_DEBUG(zero_on_gc, + __asan_unpoison_memory_region(p->start, (W_)p->blocks * BLOCK_SIZE); + memset(p->start, 0xaa, (W_)p->blocks * BLOCK_SIZE)); if (p->blocks == 0) barf("freeGroup: block size is zero"); @@ -1050,6 +1072,13 @@ freeGroup(bdescr *p) setup_tail(p); free_list_insert(node,p); + __asan_poison_memory_region(p->start, (W_)p->blocks * BLOCK_SIZE); + // Only the head and tail bdescrs of a free group carry meaning; poison the + // interior ones to catch stale Bdescr() lookups through dangling pointers. + if (p->blocks > 2) { + __asan_poison_memory_region(p + 1, ((W_)p->blocks - 2) * sizeof(bdescr)); + } + IF_DEBUG(sanity, checkFreeListSanity()); } @@ -1421,6 +1450,7 @@ reportUnmarkedBlocks (void) debugBelch("Unreachable blocks:\n"); for (mblock = getFirstMBlock(&state); mblock != NULL; mblock = getNextMBlock(&state, mblock)) { + __asan_unpoison_memory_region(mblock, FIRST_BLOCK_OFF); for (bd = FIRST_BDESCR(mblock); bd <= LAST_BDESCR(mblock); ) { if (!(bd->flags & BF_KNOWN) && bd->free != (P_)-1) { debugBelch(" %p\n",bd); ===================================== 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/NonMoving.c ===================================== @@ -597,6 +597,8 @@ static void nonmovingExitConcurrentWorker(void); void nonmovingPushFreeSegment(struct NonmovingSegment *seg) { SET_SEGMENT_STATE(seg, FREE); + __asan_poison_memory_region(seg->bitmap, + (uintptr_t)seg + NONMOVING_SEGMENT_SIZE - (uintptr_t)seg->bitmap); while (true) { struct NonmovingSegment *old = nonmovingHeap.free; seg->link = old; ===================================== rts/sm/NonMovingAllocate.c ===================================== @@ -118,6 +118,8 @@ static void nonmovingClearBitmap(struct NonmovingSegment *seg) static void nonmovingInitSegment(struct NonmovingSegment *seg, uint16_t allocator_idx) { bdescr *bd = Bdescr((P_) seg); + __asan_unpoison_memory_region(seg->bitmap, + (uintptr_t)seg + NONMOVING_SEGMENT_SIZE - (uintptr_t)seg->bitmap); seg->link = NULL; seg->todo_link = NULL; seg->next_free = 0; @@ -126,6 +128,8 @@ static void nonmovingInitSegment(struct NonmovingSegment *seg, uint16_t allocato bd->nonmoving_segment.next_free_snap = 0; bd->u.scan = nonmovingSegmentGetBlock(seg, 0); nonmovingClearBitmap(seg); + __asan_poison_memory_region(bd->u.scan, + (uintptr_t)seg + NONMOVING_SEGMENT_SIZE - (uintptr_t)bd->u.scan); } /* Initialize a new capability. Must hold SM_LOCK. */ @@ -229,6 +233,7 @@ static void *nonmovingAllocate_(enum AllocLockMode mode, Capability *cap, StgWor unsigned int block_count = nonmovingSegmentBlockCount(current); void *ret = nonmovingSegmentGetBlock_(current, block_size, block_count, current->next_free); ASSERT(GET_CLOSURE_TAG(ret) == 0); // check alignment + __asan_unpoison_memory_region(ret, block_size); // Advance the current segment's next_free or allocate a new segment if full bool full = advance_next_free(current, block_count); ===================================== rts/sm/NonMovingSweep.c ===================================== @@ -33,6 +33,7 @@ nonmovingSweepSegment(struct NonmovingSegment *seg) { ASSERT_SEGMENT_STATE(seg, FILLED_SWEEPING); const nonmoving_block_idx blk_cnt = nonmovingSegmentBlockCount(seg); + const uint16_t blk_size = nonmovingSegmentBlockSize(seg); bool found_free = false; bool found_live = false; @@ -42,6 +43,8 @@ nonmovingSweepSegment(struct NonmovingSegment *seg) found_live = true; } else { seg->bitmap[i] = 0; + __asan_poison_memory_region( + nonmovingSegmentGetBlock_(seg, blk_size, blk_cnt, i), blk_size); if (!found_free) { // This is the first free block we've found; set next_free, // next_free_snap, and the scan pointer. @@ -57,6 +60,8 @@ nonmovingSweepSegment(struct NonmovingSegment *seg) for (; i < nonmovingSegmentBlockCount(seg); ++i) { if (seg->bitmap[i] != nonmovingMarkEpoch) { seg->bitmap[i] = 0; + __asan_poison_memory_region( + nonmovingSegmentGetBlock_(seg, blk_size, blk_cnt, i), blk_size); } } return SEGMENT_PARTIAL; @@ -113,7 +118,9 @@ void nonmovingClearSegment(struct NonmovingSegment* seg) { size_t end = ((size_t)seg) + NONMOVING_SEGMENT_SIZE; + __asan_unpoison_memory_region(&seg->bitmap, end - (size_t)&seg->bitmap); memset(&seg->bitmap, 0, end - (size_t)&seg->bitmap); + __asan_poison_memory_region(&seg->bitmap, end - (size_t)&seg->bitmap); } void @@ -124,7 +131,18 @@ nonmovingClearSegmentFreeBlocks(struct NonmovingSegment* seg) // N.B. nonmovingSweepSegment helpfully clears the bitmap entries of // dead blocks if (nonmovingGetMark(seg, p_idx) == 0) { - memset(nonmovingSegmentGetBlock(seg, p_idx), 0, block_size); + void *blk = nonmovingSegmentGetBlock(seg, p_idx); + if (p_idx >= seg->next_free) { + // Free block: it is poisoned, so unpoison for the memset and + // re-poison afterwards. Unmarked blocks below next_free were + // allocated since the last sweep and are live; leave those + // unpoisoned. + __asan_unpoison_memory_region(blk, block_size); + memset(blk, 0, block_size); + __asan_poison_memory_region(blk, block_size); + } else { + memset(blk, 0, block_size); + } } } } ===================================== 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/6ba98fc8e3ab1011f5984ace5a57fae... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ba98fc8e3ab1011f5984ace5a57fae... You're receiving this email because of your account on gitlab.haskell.org.