[Git][ghc/ghc][master] Enable printf warnings for trace functions and fix resulting warnings
by Marge Bot (＠marge-bot) 10 Sep '26
by Marge Bot (＠marge-bot) 10 Sep '26
10 Sep '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
afeb2c30 by Duncan Coutts at 2026-09-09T20:08:58-04:00
Enable printf warnings for trace functions and fix resulting warnings
Most of the existing printf-style functions are annotated with
attributes to enable gcc/clang warnings for the printf format string,
but several trace functions in Trace.h were missing this annotation.
Enable them, and fix the resulting warnings.
- - - - -
21 changed files:
- rts/Capability.c
- rts/IOManager.c
- rts/Messages.c
- rts/Printer.c
- rts/STM.c
- rts/Schedule.c
- rts/Sparks.c
- rts/StableName.c
- rts/ThreadPaused.c
- rts/Threads.c
- rts/Trace.h
- rts/posix/Poll.c
- rts/posix/Timeout.c
- rts/sm/Compact.c
- rts/sm/GC.c
- rts/sm/GCUtils.c
- rts/sm/MBlock.c
- rts/sm/NonMoving.c
- rts/sm/NonMovingMark.c
- rts/sm/Storage.c
- rts/sm/Sweep.c
Changes:
=====================================
rts/Capability.c
=====================================
@@ -1396,7 +1396,9 @@ bool checkSparkCountInvariant (void)
/* The invariant is
* created = converted + remaining + gcd + fizzled
*/
- debugTrace(DEBUG_sparks,"spark invariant: %ld == %ld + %ld + %ld + %ld "
+ debugTrace(DEBUG_sparks,"spark invariant: %" FMT_Word " == "
+ "%" FMT_Word " + %" FMT_Word64 " + "
+ "%" FMT_Word " + %" FMT_Word " "
"(created == converted + remaining + gcd + fizzled)",
sparks.created, sparks.converted, remaining,
sparks.gcd, sparks.fizzled);
=====================================
rts/IOManager.c
=====================================
@@ -833,7 +833,9 @@ static void insertIntoSleepingQueue(CapIOManager *iomgr, StgTSO *tso, LowResTime
/* CMM primop. Result is true on success, or false on allocation failure. */
bool syncDelay(CapIOManager *iomgr, StgTSO *tso, HsInt us_delay)
{
- debugTrace(DEBUG_iomanager, "thread %ld waiting for %lld us", tso->id, us_delay);
+ debugTrace(DEBUG_iomanager, "thread %" FMT_StgThreadID
+ " waiting for %" FMT_Word " us",
+ tso->id, us_delay);
ASSERT(tso->why_blocked == NotBlocked);
switch (iomgr_type) {
#if defined(IOMGR_ENABLED_SELECT)
=====================================
rts/Messages.c
=====================================
@@ -134,8 +134,8 @@ loop:
if (i == &stg_MSG_TRY_WAKEUP_info)
{
StgTSO *tso = ((MessageWakeup *)m)->tso;
- debugTraceCap(DEBUG_sched, cap, "message: try wakeup thread %"
- FMT_StgThreadID, tso->id);
+ debugTraceCap(DEBUG_sched, cap,
+ "message: try wakeup thread %" FMT_StgThreadID, tso->id);
tryWakeupThread(cap, tso);
}
else if (i == &stg_MSG_THROWTO_info)
@@ -150,8 +150,8 @@ loop:
goto loop;
}
- debugTraceCap(DEBUG_sched, cap, "message: throwTo %ld -> %ld",
- (W_)t->source->id, (W_)t->target->id);
+ debugTraceCap(DEBUG_sched, cap, "message: throwTo %" FMT_StgThreadID
+ " -> %" FMT_StgThreadID, t->source->id, t->target->id);
r = throwToMsg(cap, t);
=====================================
rts/Printer.c
=====================================
@@ -554,7 +554,7 @@ printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap,
uint32_t i;
for(i = 0; i < size; i++, bitmap >>= 1 ) {
- debugBelch(" stk[%ld] (%p) = ", (long)(spBottom-(payload+i)), payload+i);
+ debugBelch(" stk[%td] (%p) = ", spBottom-(payload+i), payload+i);
if ((bitmap & 1) == 0) {
printPtr((P_)payload[i]);
debugBelch(" -- ");
@@ -577,7 +577,7 @@ printLargeBitmap( StgPtr spBottom, StgPtr payload, StgLargeBitmap* large_bitmap,
StgWord bitmap = large_bitmap->bitmap[bmp];
j = 0;
for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) {
- debugBelch(" stk[%" FMT_Word "] (%p) = ", (W_)(spBottom-(payload+i)), payload+i);
+ debugBelch(" stk[%td] (%p) = ", spBottom-(payload+i), payload+i);
if ((bitmap & 1) == 0) {
printPtr((P_)payload[i]);
debugBelch(" -- ");
=====================================
rts/STM.c
=====================================
@@ -134,7 +134,8 @@ static int shake(void) {
StgTRecHeader *__t = (_t); \
StgTRecChunk *__c = __t -> current_chunk; \
StgWord __limit = __c -> next_entry_idx; \
- TRACE("%p : FOR_EACH_ENTRY, current_chunk=%p limit=%ld", __t, __c, __limit); \
+ TRACE("%p : FOR_EACH_ENTRY, current_chunk=%p limit=%" FMT_Word, \
+ __t, __c, __limit); \
while (__c != END_STM_CHUNK_LIST) { \
StgWord __i; \
for (__i = 0; __i < __limit; __i ++) { \
@@ -780,7 +781,7 @@ static StgBool validate_and_acquire_ownership (Capability *cap,
result = false;
BREAK_FOR_EACH;
} else {
- TRACE("%p : need to check version %ld", trec, e -> num_updates);
+ TRACE("%p : need to check version %" FMT_Int, trec, e->num_updates);
}
});
}
@@ -815,7 +816,8 @@ static StgBool check_read_only(StgTRecHeader *trec STG_UNUSED) {
StgTVar *s;
s = e -> tvar;
if (entry_is_read_only(e)) {
- TRACE("%p : check_read_only for TVar %p, saw %ld", trec, s, e -> num_updates);
+ TRACE("%p : check_read_only for TVar %p, saw %" FMT_Int,
+ trec, s, e->num_updates);
// We must first load current_value then num_updates; this is inverse of
// the order of the stores in stmCommitTransaction.
@@ -1199,7 +1201,7 @@ of these false-positives causing actual issues.
StgBool stmValidateNestOfTransactions(Capability *cap, StgTRecHeader *trec, StgBool optimistically) {
StgTRecHeader *t;
- TRACE("%p : stmValidateNestOfTransactions, %b", trec, optimistically);
+ TRACE("%p : stmValidateNestOfTransactions, %d", trec, optimistically);
ASSERT(trec != NO_TREC);
ASSERT((trec -> state == TREC_ACTIVE) ||
(trec -> state == TREC_WAITING) ||
=====================================
rts/Schedule.c
=====================================
@@ -1157,8 +1157,9 @@ scheduleHandleHeapOverflow( Capability *cap, StgTSO *t )
#if defined(DEBUG)
debugTrace(DEBUG_sched,
- "--<< thread %ld (%s) stopped: requesting a large block (size %ld)\n",
- (long)t->id, what_next_strs[t->what_next], blocks);
+ "--<< thread %" FMT_StgThreadID " (%s) stopped: "
+ "requesting a large block (size %" FMT_Word ")\n",
+ t->id, what_next_strs[t->what_next], blocks);
#endif
// don't do this if the nursery is (nearly) full, we'll GC first.
=====================================
rts/Sparks.c
=====================================
@@ -140,7 +140,8 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap)
pool->top &= pool->moduloSize;
debugTrace(DEBUG_sparks,
- "markSparkQueue: current spark queue len=%ld; (hd=%ld; tl=%ld)",
+ "markSparkQueue: current spark queue len=%ld; "
+ "(hd=%" FMT_Int "; tl=%" FMT_Int ")",
sparkPoolSize(pool), pool->bottom, pool->top);
ASSERT_WSDEQUE_INVARIANTS(pool);
@@ -288,7 +289,7 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap)
debugTrace(DEBUG_sparks, "pruned %d sparks", pruned_sparks);
debugTrace(DEBUG_sparks,
- "new spark queue len=%ld; (hd=%ld; tl=%ld)",
+ "new spark queue len=%ld; (hd=%" FMT_Int "; tl=%" FMT_Int ")",
sparkPoolSize(pool), pool->bottom, pool->top);
ASSERT_WSDEQUE_INVARIANTS(pool);
@@ -322,7 +323,8 @@ traverseSparkQueue (evac_fn evac, void *user, Capability *cap)
}
debugTrace(DEBUG_sparks,
- "traversed spark queue, len=%ld; (hd=%ld; tl=%ld)",
+ "traversed spark queue, len=%ld; "
+ "(hd=%" FMT_Int "; tl=%" FMT_Int ")",
sparkPoolSize(pool), pool->bottom, pool->top);
}
=====================================
rts/StableName.c
=====================================
@@ -195,7 +195,7 @@ lookupStableName (StgPtr p)
if (sn != 0) {
ASSERT(stable_name_table[sn].addr == p);
- debugTrace(DEBUG_stable, "cached stable name %ld at %p",sn,p);
+ debugTrace(DEBUG_stable, "cached stable name %" FMT_Word " at %p", sn, p);
stableNameUnlock();
return sn;
}
@@ -275,8 +275,8 @@ gcStableNameTable( void )
p->sn_obj = isAlive(p->sn_obj);
if (p->sn_obj == NULL) {
// StableName object died
- debugTrace(DEBUG_stable, "GC'd StableName %ld (addr=%p)",
- (long)(p - stable_name_table), p->addr);
+ debugTrace(DEBUG_stable, "GC'd StableName %td (addr=%p)",
+ p - stable_name_table, p->addr);
freeSnEntry(p);
} else if (p->addr != NULL) {
// sn_obj is alive, update pointee
=====================================
rts/ThreadPaused.c
=====================================
@@ -315,8 +315,8 @@ threadPaused(Capability *cap, StgTSO *tso)
|| (bh_info == &stg_WHITEHOLE_info))
{
debugTrace(DEBUG_squeeze,
- "suspending duplicate work: %ld words of stack",
- (long)((StgPtr)frame - tso->stackobj->sp));
+ "suspending duplicate work: %td words of stack",
+ (StgPtr)frame - tso->stackobj->sp);
// If this closure is already an indirection, then
// suspend the computation up to this point.
=====================================
rts/Threads.c
=====================================
@@ -609,7 +609,7 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
debugTrace(DEBUG_gc,
"threadStackOverflow of TSO %" FMT_StgThreadID " (%p): stack"
- " too large (now %ld; max is %ld)", tso->id, tso,
+ " too large (now %ld; max is %u)", tso->id, tso,
(long)tso->stackobj->stack_size, RtsFlags.GcFlags.maxStkSize);
IF_DEBUG(gc,
/* If we're debugging, just print out the top of the stack */
@@ -667,7 +667,7 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
}
debugTraceCap(DEBUG_sched, cap,
- "allocating new stack chunk of size %d bytes",
+ "allocating new stack chunk of size %" FMT_Word " bytes",
chunk_size * sizeof(W_));
// Charge the current thread for allocating stack. Stack usage is
@@ -966,7 +966,8 @@ printThreadBlockage(StgTSO *tso)
switch (UntagWhyBlocked(ACQUIRE_LOAD(&tso->why_blocked))) {
#if defined(mingw32_HOST_OS)
case BlockedOnDoProc:
- debugBelch("is blocked on proc (request: %" FMT_Word ")", tso->block_info.async_reqID);
+ debugBelch("is blocked on proc (request: %" FMT_Word ")",
+ tso->block_info.async_reqID);
break;
#endif
#if !defined(THREADED_RTS)
=====================================
rts/Trace.h
=====================================
@@ -113,7 +113,7 @@ extern RUNTIME_TRACE_FLAG_CACHE RuntimeTraceFlagCache;
// -----------------------------------------------------------------------------
#if defined(DEBUG)
-void traceBegin (const char *str, ...);
+void traceBegin (const char *str, ...) STG_PRINTF_ATTR(1, 2);
void traceEnd (void);
#endif
@@ -265,7 +265,8 @@ void traceSparkEvent_ (Capability *cap, EventTypeNum tag, StgWord info1);
traceCap_(cap, msg, ##__VA_ARGS__); \
}
-void traceCap_(Capability *cap, char *msg, ...);
+void traceCap_(Capability *cap, char *msg, ...)
+ STG_PRINTF_ATTR(2, 3);
/*
* Emit a trace message
@@ -275,7 +276,8 @@ void traceCap_(Capability *cap, char *msg, ...);
trace_(msg, ##__VA_ARGS__); \
}
-void trace_(char *msg, ...);
+void trace_(char *msg, ...)
+ STG_PRINTF_ATTR(1, 2);
/*
* A message or event emitted by the program
=====================================
rts/posix/Poll.c
=====================================
@@ -421,14 +421,14 @@ void pollCompletedTimeoutsOrIOPoll(CapIOManager *iomgr)
int res = ppoll(poll_table, nfds, &tv, NULL);
debugTrace(DEBUG_iomanager,
- "ppoll(nfds = %d, timeout.sec = 0, timeout.nsec = 0) = %d",
- nfds, res);
+ "ppoll(nfds = %lu, timeout.sec = 0, timeout.nsec = 0) = %d",
+ (unsigned long) nfds, res);
#else
int res = poll(poll_table, nfds, 0);
debugTrace(DEBUG_iomanager,
- "poll(nfds = %d, timeout_ms = 0) = %d",
- nfds, res);
+ "poll(nfds = %lu, timeout_ms = 0) = %d",
+ (unsigned long) nfds, res);
#endif
if (res == 0) {
/* There is no I/O ready. We'll return to the scheduler. */
@@ -502,15 +502,17 @@ bool awaitCompletedTimeoutsOrIOPoll(CapIOManager *iomgr)
int res = ppoll(poll_table, nfds, timeout_ns, NULL);
debugTrace(DEBUG_iomanager,
- "ppoll(nfds = %d, timeout.sec = %d, timeout.nsec = %d) = %d",
- nfds, timeout_ns == NULL ? -1 : timeout_ns->tv_sec,
- timeout_ns == NULL ? 0 : timeout_ns->tv_nsec,
+ "ppoll(nfds = %lu, timeout.sec = %lld, timeout.nsec = %lld)"
+ " = %d",
+ (unsigned long) nfds,
+ (long long) (timeout_ns == NULL ? -1 : timeout_ns->tv_sec),
+ (long long) (timeout_ns == NULL ? 0 : timeout_ns->tv_nsec),
res);
#else
int res = poll(poll_table, nfds, timeout_ms);
debugTrace(DEBUG_iomanager,
- "poll(nfds = %d, timeout_ms = %d) = %d",
+ "poll(nfds = %lu, timeout_ms = %d) = %d",
nfds, timeout_ms, res);
#endif
=====================================
rts/posix/Timeout.c
=====================================
@@ -54,7 +54,8 @@ bool syncDelayTimeout(CapIOManager *iomgr, StgTSO *tso, HsInt us_delay)
insertTimeoutQueue(&iomgr->timeout_queue, timeout, target);
debugTrace(DEBUG_iomanager,
- "timer for delay of %lld usec installed at time %lld ns",
+ "timer for delay of %" FMT_Int " usec installed "
+ "at time %" FMT_Int64 " ns",
us_delay, target);
return true;
}
@@ -98,7 +99,8 @@ void processTimeoutCompletions(CapIOManager *iomgr, Time now)
if (now < waketime) {
break;
}
- debugTrace(DEBUG_iomanager,"timer expired at %lld ns", waketime);
+ debugTrace(DEBUG_iomanager, "timer expired at %" FMT_Int64 " ns",
+ waketime);
StgTimeout *timeout;
deleteMinTimeoutQueue(&iomgr->timeout_queue, &timeout);
notifyTimeoutCompletion(iomgr, timeout);
=====================================
rts/sm/Compact.c
=====================================
@@ -1049,7 +1049,7 @@ compact(StgClosure *static_objects,
// 2. update forward ptrs
for (W_ g = 0; g < RtsFlags.GcFlags.generations; g++) {
generation *gen = &generations[g];
- debugTrace(DEBUG_gc, "update_fwd: %d", g);
+ debugTrace(DEBUG_gc, "update_fwd: %" FMT_Word, g);
update_fwd(gen->blocks);
for (W_ n = 0; n < getNumCapabilities(); n++) {
@@ -1059,7 +1059,7 @@ compact(StgClosure *static_objects,
update_fwd_large(gen->scavenged_large_objects);
update_fwd_cnf(gen->live_compact_objects);
if (g == RtsFlags.GcFlags.generations-1 && gen->old_blocks != NULL) {
- debugTrace(DEBUG_gc, "update_fwd: %d (compact)", g);
+ debugTrace(DEBUG_gc, "update_fwd: %" FMT_Word " (compact)", g);
update_fwd_compact(gen->old_blocks);
}
}
@@ -1069,7 +1069,8 @@ compact(StgClosure *static_objects,
if (gen->old_blocks != NULL) {
W_ blocks = update_bkwd_compact(gen);
debugTrace(DEBUG_gc,
- "update_bkwd: %d (compact, old: %d blocks, now %d blocks)",
+ "update_bkwd: %d (compact, old: %" FMT_Word " blocks, "
+ "now %" FMT_Word " blocks)",
gen->no, gen->n_old_blocks, blocks);
gen->n_old_blocks = blocks;
}
=====================================
rts/sm/GC.c
=====================================
@@ -636,13 +636,13 @@ GarbageCollect (struct GcConfig config,
if(idle_cap[i]) { continue; }
thread = gc_threads[i];
debugTrace(DEBUG_gc,"thread %d:", i);
- debugTrace(DEBUG_gc," copied %ld",
+ debugTrace(DEBUG_gc," copied %" FMT_Word,
RELAXED_LOAD(&thread->copied) * sizeof(W_));
- debugTrace(DEBUG_gc," scanned %ld",
+ debugTrace(DEBUG_gc," scanned %" FMT_Word,
RELAXED_LOAD(&thread->scanned) * sizeof(W_));
- debugTrace(DEBUG_gc," any_work %ld",
+ debugTrace(DEBUG_gc," any_work %" FMT_Word,
RELAXED_LOAD(&thread->any_work));
- debugTrace(DEBUG_gc," scav_find_work %ld",
+ debugTrace(DEBUG_gc," scav_find_work %" FMT_Word ,
RELAXED_LOAD(&thread->scav_find_work));
any_work += RELAXED_LOAD(&thread->any_work);
@@ -694,7 +694,15 @@ GarbageCollect (struct GcConfig config,
#if defined(DEBUG)
debugTrace(DEBUG_gc,
- "mut_list_size: %lu (%d vars, %d arrays, %d MVARs, %d TVARs, %d TVAR_WATCH_QUEUEs, %d TREC_CHUNKs, %d TREC_HEADERs, %d others)",
+ "mut_list_size: %lu ("
+ "%" FMT_Word " vars, "
+ "%" FMT_Word " arrays, "
+ "%" FMT_Word " MVARs, "
+ "%" FMT_Word " TVARs, "
+ "%" FMT_Word " TVAR_WATCH_QUEUEs, "
+ "%" FMT_Word " TREC_CHUNKs, "
+ "%" FMT_Word " TREC_HEADERs, "
+ "%" FMT_Word " others)",
(unsigned long)(mut_list_size * sizeof(W_)),
mutlist_scav_stats.n_MUTVAR,
mutlist_scav_stats.n_MUTARR,
@@ -914,7 +922,7 @@ GarbageCollect (struct GcConfig config,
// Free the mark stack.
if (mark_stack_top_bd != NULL) {
- debugTrace(DEBUG_gc, "mark stack: %d blocks",
+ debugTrace(DEBUG_gc, "mark stack: %" FMT_Word " blocks",
countBlocks(mark_stack_top_bd));
freeChain(mark_stack_top_bd);
}
@@ -1018,7 +1026,9 @@ GarbageCollect (struct GcConfig config,
need_copied_live = BLOCK_ROUND_UP(need_copied_live) / BLOCK_SIZE_W;
need_uncopied_live = BLOCK_ROUND_UP(need_uncopied_live) / BLOCK_SIZE_W;
- debugTrace(DEBUG_gc, "(before) copied_live: %d; uncopied_live: %d", need_copied_live, need_uncopied_live );
+ debugTrace(DEBUG_gc, "(before) copied_live: %" FMT_Word "; "
+ "uncopied_live: %" FMT_Word,
+ need_copied_live, need_uncopied_live);
// minOldGenSize states that the size of the oldest generation must be at least
@@ -1027,7 +1037,8 @@ GarbageCollect (struct GcConfig config,
if (RtsFlags.GcFlags.minOldGenSize >= need_copied_live + need_uncopied_live){
extra_needed = RtsFlags.GcFlags.minOldGenSize - (need_copied_live + need_uncopied_live);
}
- debugTrace(DEBUG_gc, "(minOldGen: %d; extra_needed: %d", RtsFlags.GcFlags.minOldGenSize, extra_needed);
+ debugTrace(DEBUG_gc, "(minOldGen: %d; extra_needed: %" FMT_Word,
+ RtsFlags.GcFlags.minOldGenSize, extra_needed);
// If oldest gen is uncopying in some manner (compact or non-moving) then
// add the extra requested by minOldGenSize to uncopying portion of memory.
@@ -1041,7 +1052,9 @@ GarbageCollect (struct GcConfig config,
ASSERT(need_uncopied_live + need_copied_live >= RtsFlags.GcFlags.minOldGenSize );
- debugTrace(DEBUG_gc, "(after) copied_live: %d; uncopied_live: %d", need_copied_live, need_uncopied_live );
+ debugTrace(DEBUG_gc, "(after) copied_live: %" FMT_Word "; "
+ "uncopied_live: %" FMT_Word,
+ need_copied_live, need_uncopied_live);
need_prealloc = 0;
for (i = 0; i < n_nurseries; i++) {
@@ -1098,7 +1111,7 @@ GarbageCollect (struct GcConfig config,
need = BLOCKS_TO_MBLOCKS(need);
got = mblocks_allocated;
- debugTrace(DEBUG_gc,"Returning: %d %d", got, need);
+ debugTrace(DEBUG_gc, "Returning: %" FMT_Word " %" FMT_Word, got, need);
uint32_t returned = 0;
if (got > need) {
@@ -1772,7 +1785,7 @@ prepare_collected_gen (generation *gen)
gen->bitmap = bitmap_bdescr;
bitmap = bitmap_bdescr->start;
- debugTrace(DEBUG_gc, "bitmap_size: %d, bitmap: %p",
+ debugTrace(DEBUG_gc, "bitmap_size: %" FMT_Word ", bitmap: %p",
bitmap_size, bitmap);
// don't forget to fill it with zeros!
@@ -2109,7 +2122,8 @@ resize_nursery (void)
adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks);
- debugTrace(DEBUG_gc, "near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld",
+ debugTrace(DEBUG_gc, "near maximum heap size of 0x%x blocks, "
+ "blocks = %" FMT_Word ", adjusted to %ld",
RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks);
pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize;
=====================================
rts/sm/GCUtils.c
=====================================
@@ -173,9 +173,10 @@ push_scanned_block (bdescr *bd, gen_workspace *ws)
void
push_todo_block(bdescr *bd, gen_workspace *ws)
{
- debugTrace(DEBUG_gc, "push todo block %p (%ld words), step %d, todo_q: %ld",
- bd->start, (unsigned long)(bd->free - bd->u.scan),
- ws->gen->no, dequeElements(ws->todo_q));
+ debugTrace(DEBUG_gc, "push todo block %p (%ld words), step %d, "
+ "todo_q: %" FMT_Int,
+ bd->start, (unsigned long)(bd->free - bd->u.scan),
+ ws->gen->no, dequeElements(ws->todo_q));
ASSERT(bd->link == NULL);
=====================================
rts/sm/MBlock.c
=====================================
@@ -398,7 +398,8 @@ void releaseFreeMemory(void)
// Do nothing if USE_LARGE_ADDRESS_SPACE, we never want
// to release address space
- debugTrace(DEBUG_gc, "mblock_high_watermark: %p\n", mblock_high_watermark);
+ debugTrace(DEBUG_gc, "mblock_high_watermark: %p\n",
+ (void*)mblock_high_watermark);
}
#else // !USE_LARGE_ADDRESS_SPACE
=====================================
rts/sm/NonMoving.c
=====================================
@@ -707,7 +707,7 @@ void nonmovingPruneFreeSegmentList(void)
oldest_gen->n_words -= pruned_segments * NONMOVING_SEGMENT_SIZE;
nonmovingHeap.saved_free = NULL;
debugTrace(DEBUG_nonmoving_gc,
- "Pruned %d free segments, leaving %d on the free segment list.",
+ "Pruned %zd free segments, leaving %zd on the free segment list.",
pruned_segments, new_length);
traceNonmovingPrunedSegments(pruned_segments, new_length);
trace(TRACE_nonmoving_gc, "Finished pruning free segment list.");
=====================================
rts/sm/NonMovingMark.c
=====================================
@@ -370,7 +370,8 @@ void nonmovingBeginFlush(Task *task)
bool nonmovingWaitForFlush(void)
{
ACQUIRE_LOCK(&upd_rem_set_lock);
- debugTrace(DEBUG_nonmoving_gc, "Flush count %d", upd_rem_set_flush_count);
+ debugTrace(DEBUG_nonmoving_gc, "Flush count %" FMT_Word,
+ upd_rem_set_flush_count);
bool finished = upd_rem_set_flush_count == getNumCapabilities();
if (!finished) {
waitCondition(&upd_rem_set_flushed_cond, &upd_rem_set_lock);
@@ -1872,7 +1873,8 @@ nonmovingMark (MarkBudget* budget, MarkQueue *queue)
RELEASE_SM_LOCK;
} else {
// Nothing more to do
- debugTrace(DEBUG_nonmoving_gc, "Finished mark pass: %d", count);
+ debugTrace(DEBUG_nonmoving_gc,
+ "Finished mark pass: %" FMT_Word64, count);
traceConcMarkEnd(count);
return;
}
=====================================
rts/sm/Storage.c
=====================================
@@ -874,7 +874,8 @@ resizeNurseriesEach (W_ blocks)
node = capNoToNumaNode(i);
if (nursery_blocks < blocks) {
- debugTrace(DEBUG_gc, "increasing size of nursery from %d to %d blocks",
+ debugTrace(DEBUG_gc, "increasing size of nursery from %" FMT_Word
+ " to %" FMT_Word " blocks",
nursery_blocks, blocks);
nursery->blocks = allocNursery(node, nursery->blocks,
blocks-nursery_blocks);
@@ -883,7 +884,8 @@ resizeNurseriesEach (W_ blocks)
{
bdescr *next_bd;
- debugTrace(DEBUG_gc, "decreasing size of nursery from %d to %d blocks",
+ debugTrace(DEBUG_gc, "decreasing size of nursery from %" FMT_Word
+ " to %" FMT_Word " blocks",
nursery_blocks, blocks);
bd = nursery->blocks;
@@ -898,7 +900,8 @@ resizeNurseriesEach (W_ blocks)
// might have gone just under, by freeing a large block, so make
// up the difference.
if (nursery_blocks < blocks) {
- debugTrace(DEBUG_gc, "reincreasing size of nursery from %d to %d blocks",
+ debugTrace(DEBUG_gc, "reincreasing size of nursery from"
+ " %" FMT_Word " to %" FMT_Word " blocks",
nursery_blocks, blocks);
nursery->blocks = allocNursery(node, nursery->blocks,
blocks-nursery_blocks);
=====================================
rts/sm/Sweep.c
=====================================
@@ -74,7 +74,11 @@ sweep(generation *gen)
gen->live_estimate = live;
- debugTrace(DEBUG_gc, "sweeping: %d blocks, %d were copied, %d freed (%d%%), %d are fragmented, live estimate: %ld%%",
+ debugTrace(DEBUG_gc, "sweeping: %" FMT_Word " blocks, "
+ "%" FMT_Word " were copied, "
+ "%" FMT_Word " freed (%" FMT_Word "%%), "
+ "%" FMT_Word " are fragmented, "
+ "live estimate: %lu%%",
gen->n_old_blocks + freed,
gen->n_old_blocks - blocks + freed,
freed,
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/afeb2c3042c36dd1d0fc01c765acb85…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/afeb2c3042c36dd1d0fc01c765acb85…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][master] 8 commits: Reorder cmm decls in HeapStackCheck for a better logical grouping
by Marge Bot (＠marge-bot) 10 Sep '26
by Marge Bot (＠marge-bot) 10 Sep '26
10 Sep '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
430967ab by Duncan Coutts at 2026-09-09T11:07:01+01:00
Reorder cmm decls in HeapStackCheck for a better logical grouping
And put more section headers in to deliniate the groups.
We're about to add more here, so better to organise it first.
- - - - -
344080fd by Duncan Coutts at 2026-09-09T11:07:01+01:00
Add raisePrimIOException and add it to RTS<->ghc-internal API
The raisePrimIOException is a new helper function that I/O primops will
use to help them report I/O errors. This is implemented in Haskell
(since that's a lot easier), but has a calling convention that is
easy(ish) to use from Cmm in the I/O primops.
So we add it to the RTS API struct, and since we'll use it from Cmm we
also need a field accessor macro for cmm (in deriveConstants).
See the Note about how we cannot have nice things due to async
exceptions and thunks preventing us from using catch.
- - - - -
cfdb3399 by Duncan Coutts at 2026-09-09T11:07:01+01:00
Add new blocking functions for I/O primops
See the Note [Thread blocking for new I/O primops],
and the Note [Calling convention for raisePrimIOException].
The point is, it will allow us to report synchronous exceptions from I/O
primops, and do so much more flexibly.
Previously the I/O managers could only report async exceptions and only
nullary exceptions. This was OK historically, but no good as we add
more I/O managers and expand the range of I/O operations we support.
- - - - -
f09c09d8 by Duncan Coutts at 2026-09-09T11:07:01+01:00
Change the encoding of results from the I/O manager to I/O primops
Previously we just had async continue or heap overflow.
We now extend what we can report with synchronous success, and
synchronous failure with an errno.
See Note [Encoding of result of I/O manager operations]
We don't use these two new cases yet, but we will. In particular an
epoll I/O manager needs to be able to report synchronous success or
failure for waitRead#/waitWrite#.
- - - - -
30f074d9 by Duncan Coutts at 2026-09-09T11:07:01+01:00
Switch waitRead/Write# to use new blocking return frames
and update the I/O managers to set the result before resuming the
blocked threads.
This makes it possible for I/O managers to report synchronous exceptions
from the I/O primops, but that will be done in a subsequent commit.
- - - - -
a8786ced by Duncan Coutts at 2026-09-09T11:07:01+01:00
Switch Poll and Select I/O managers to report sync exceptions
rather than using raiseAsync with blockedOnBadFD_closure.
This uses the new mechanism in the blocking frame return code to report
synchronous exceptions.
- - - - -
7a9df79a by Duncan Coutts at 2026-09-09T11:07:01+01:00
Remove now-unused blockedOnBadFD
It was previously thrown by the select and poll I/O managers, but now
they use raisePrimIOException (with an EBADF errno).
- - - - -
6b0424e3 by Duncan Coutts at 2026-09-09T11:07:01+01:00
Improve the docs for delay# waitRead# and waitWrite#
Document that the waitRead/Write# can throw exceptions (this was true
before too), and that all of them are async exception cancellation
points.
- - - - -
16 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- libraries/ghc-internal/include/RtsIfaceSymbols.h
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
- rts/HeapStackCheck.cmm
- rts/IOManager.c
- rts/IOManager.h
- rts/IOManagerInternals.h
- rts/Prelude.h
- rts/PrimOps.cmm
- rts/include/rts/RtsToHsIface.h
- rts/include/stg/MiscClosures.h
- rts/posix/Poll.c
- rts/posix/Poll.h
- rts/posix/Select.c
- utils/deriveConstants/Main.hs
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -3305,21 +3305,28 @@ section "Delay/wait operations"
primop DelayOp "delay#" GenPrimOp
Int# -> State# s -> State# s
- {Sleep specified number of microseconds.}
+ {Suspend the calling thread for a specified number of microseconds. This
+ operation is /interruptible/ by async exceptions.}
with
effect = ReadWriteEffect
out_of_line = True
primop WaitReadOp "waitRead#" GenPrimOp
Int# -> State# s -> State# s
- {Block until input is available on specified file descriptor.}
+ {Suspend the calling thread until input is available (or an I/O error
+ occurs) on the given file descriptor. This operation can throw exceptions
+ of type 'IOException'. The operation is also /interruptible/ by async
+ exceptions.}
with
effect = ReadWriteEffect
out_of_line = True
primop WaitWriteOp "waitWrite#" GenPrimOp
Int# -> State# s -> State# s
- {Block until output is possible on specified file descriptor.}
+ {Suspend the calling thread until output is possible (or an I/O error
+ occurs) on the given file descriptor. This operation can throw exceptions
+ of type 'IOException'. The operation is also /interruptible/ by async
+ exceptions.}
with
effect = ReadWriteEffect
out_of_line = True
=====================================
libraries/ghc-internal/include/RtsIfaceSymbols.h
=====================================
@@ -23,15 +23,11 @@ CLOSURE(GHCziInternalziIOziException, cannotCompactMutable_closure)
CLOSURE(GHCziInternalziControlziExceptionziBase, nonTermination_closure)
CLOSURE(GHCziInternalziControlziExceptionziBase, nestedAtomically_closure)
CLOSURE(GHCziInternalziControlziExceptionziBase, noMatchingContinuationPrompt_closure)
-#if defined(mingw32_HOST_OS)
-UNDEF_CLOSURE(GHCziInternalziEventziThread, blockedOnBadFD_closure)
-#else
-CLOSURE(GHCziInternalziEventziThread, blockedOnBadFD_closure)
-#endif
CLOSURE(GHCziInternalziConcziSync, runSparks_closure)
CLOSURE(GHCziInternalziConcziIO, ensureIOManagerIsRunning_closure)
CLOSURE(GHCziInternalziConcziIO, interruptIOManager_closure)
CLOSURE(GHCziInternalziConcziIO, ioManagerCapabilitiesChanged_closure)
+CLOSURE(GHCziInternalziConcziIO, raisePrimIOException_info)
CLOSURE(GHCziInternalziConcziSignal, runHandlersPtr_closure)
CLOSURE(GHCziInternalziTopHandler, flushStdHandles_closure)
CLOSURE(GHCziInternalziTopHandler, runMainIO_closure)
=====================================
libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
=====================================
@@ -56,13 +56,19 @@ module GHC.Internal.Conc.IO
, win32ConsoleHandler
, toWin32ConsoleEvent
#endif
+ , raisePrimIOException -- exported for use within RTS
) where
import GHC.Internal.Base
import GHC.Internal.Conc.Sync as Sync
import GHC.Internal.Err (errorWithoutStackTrace)
+import GHC.Internal.Exception (SomeException, Exception(toException))
+import qualified GHC.Internal.Foreign.C.Error as C
+import GHC.Internal.Foreign.C.Types (CInt)
+import GHC.Internal.Maybe (Maybe(Nothing))
import GHC.Internal.STM as STM
-import GHC.Internal.Prim (delay#, waitRead#, waitWrite#)
+import GHC.Internal.Prim (Int#, State#, RealWorld,
+ delay#, waitRead#, waitWrite#, raiseIO#)
import GHC.Internal.Real ( fromIntegral )
import GHC.Internal.System.Posix.Types
@@ -249,3 +255,39 @@ registerDelay _usecs
#if !defined(javascript_HOST_ARCH)
foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
#endif
+
+
+-- ---------------------------------------------------------------------------
+-- PrimIOException
+
+-- FIXME: raisePrimIOException throws an IOException, which is not ideal. It is
+-- not in a position to fill in most of the information for an IOException.
+-- Much better would be to have a new PrimIOException exception type, and for
+-- I/O primops to catch that and rethrow with the proper context. In particular
+-- we do not have a proper location, since that's fundamantally something from
+-- a higher level library.
+--
+-- Unfortunately, catching and throwing converts async exceptions to sync ones.
+-- This breaks any thunks that, via unsafePerformIO, use such operations. We
+-- have tests that check for this, e.g. T26341a T26341b. Catching and rethrowing
+-- here would break those tests.
+--
+-- See issue #2558, #24189 and #26368.
+
+-- | Internal helper funtion used by the in-RTS I\/O managers for reporting
+-- exceptions. Do not use directly.
+--
+-- Do not change the type signature \/ ABI without updating the Cmm callers!
+-- There is no signature checking for Cmm to Hs calls.
+--
+raisePrimIOException :: Int# -> State# RealWorld -> (# State# RealWorld, a #)
+raisePrimIOException errno# s =
+ let exception :: SomeException
+ exception = toException
+ (C.errnoToIOError "threadWaitRead/Write"
+ (toCErrno errno#)
+ Nothing Nothing)
+ in raiseIO# exception s
+ where
+ toCErrno :: Int# -> C.Errno
+ toCErrno e = C.Errno ((fromIntegral :: Int -> CInt) (I# e))
=====================================
libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
=====================================
@@ -23,14 +23,13 @@ import GHC.Internal.Types ()
, closeFdWith
, threadDelay
, registerDelay
- , blockedOnBadFD -- used by RTS
) where
-- TODO: Use new Windows I/O manager
import qualified GHC.Internal.Stack.Types as Rebindable
import GHC.Internal.Base
-import GHC.Internal.Control.Exception (finally, SomeException, toException)
+import GHC.Internal.Control.Exception (finally)
import GHC.Internal.Data.Foldable (forM_, mapM_, sequence_)
import GHC.Internal.Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicWriteIORef)
import GHC.Internal.Data.Maybe (fromMaybe)
@@ -185,10 +184,6 @@ threadWait evt fd = mask_ $ do
then ioError $ errnoToIOError "threadWait" eBADF Nothing Nothing
else return ()
--- used at least by RTS in 'select()' IO manager backend
-blockedOnBadFD :: SomeException
-blockedOnBadFD = toException $ errnoToIOError "awaitEvent" eBADF Nothing Nothing
-
threadWaitSTM :: Event -> Fd -> IO (STM (), IO ())
threadWaitSTM evt fd = mask_ $ do
m <- newTVarIO Nothing
=====================================
rts/HeapStackCheck.cmm
=====================================
@@ -20,6 +20,7 @@ import ReleaseSRWLockExclusives;
#if !defined(UnregisterisedCompiler)
import CLOSURE g0;
import CLOSURE large_alloc_lim;
+import CLOSURE ghc_hs_iface;
import CLOSURE stg_MSG_THROWTO_info;
import CLOSURE stg_MVAR_DIRTY_info;
import CLOSURE stg_WHITEHOLE_info;
@@ -40,6 +41,8 @@ import CLOSURE stg_ret_l_info;
import CLOSURE stg_ret_n_info;
import CLOSURE stg_ret_p_info;
import CLOSURE stg_stack_save_entries;
+import CLOSURE stg_block_io_unit_info;
+import CLOSURE stg_block_io_int_info;
#endif
/* Stack/Heap Check Failure
@@ -694,6 +697,37 @@ stg_block_putmvar (P_ mvar, P_ val)
}
}
+
+/* -----------------------------------------------------------------------------
+ STM-specific waiting
+ -------------------------------------------------------------------------- */
+
+stg_block_stmwait
+{
+ // When blocking on an MVar we have to be careful to only release
+ // the lock on the MVar at the very last moment (using
+ // BLOCK_BUT_FIRST()), since when we release the lock another
+ // Capability can wake up the thread, which modifies its stack and
+ // other state. This is not a problem for STM, because STM
+ // wakeups are non-destructive; the waker simply calls
+ // tryWakeupThread() which sends a message to the owner
+ // Capability. So the moment we release this lock we might start
+ // getting wakeup messages, but that's perfectly harmless.
+ //
+ // Furthermore, we *must* release these locks, just in case an
+ // exception is raised in this thread by
+ // maybePerformBlockedException() while exiting to the scheduler,
+ // which will abort the transaction, which needs to obtain a lock
+ // on all the TVars to remove the thread from the queues.
+ //
+ ccall stmWaitUnlock(MyCapability() "ptr", R3 "ptr");
+ BLOCK_GENERIC;
+}
+
+/* -----------------------------------------------------------------------------
+ Blocks for blackholes and throwto
+ -------------------------------------------------------------------------- */
+
stg_block_blackhole (P_ node)
{
Sp_adj(-2);
@@ -730,6 +764,13 @@ stg_block_throwto (P_ tso, P_ exception)
}
}
+/* -----------------------------------------------------------------------------
+ Thread blocking for I/O primops
+ -------------------------------------------------------------------------- */
+
+/* Thread blocking for primops used only by the win32-legacy I/O manager:
+ * asyncRead, asyncWrite and asyncDoProc.
+ */
#if defined(mingw32_HOST_OS)
INFO_TABLE_RET ( stg_block_async, RET_SMALL, W_ info_ptr, W_ len, W_ errCode )
return ()
@@ -751,32 +792,171 @@ stg_block_async
Sp(2) = eintr; // errCode: interrupted
BLOCK_GENERIC;
}
-
#endif
+/* Note [Thread blocking for new I/O primops]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-/* -----------------------------------------------------------------------------
- STM-specific waiting
- -------------------------------------------------------------------------- */
+The classic I/O primops are:
-stg_block_stmwait
+ waitRead#, waitWrite# :: Int# -> State# s -> State# s
+
+Note that they have no result, with wrapper types returning IO (). Each one
+simply suspends the calling thread until a condition occurs (I/O or time).
+
+Despite this external simplicity, internally there is more complexity with a
+number of cases to handle:
+
+At submission time:
+ - synchronous failure, e.g. bad fd
+ - synchronous success, e.g. waiting on a regular file, which is always ready
+ - proceed asynchronously: block thread, return to scheduler
+
+Later, at I/O completion, I/O error, or async exception time:
+ - reported failure, e.g. stale fd
+ - success
+
+The waitRead/Write# also have non-reported failures, such as I/O errors,
+but these are treated as the success case since these primops are defined to
+wait for I/O or an error. We only report failures, via exceptions, for cases
+where it would be unsafe to proceed with a subsequent I/O operation on the
+same fd. In particular this includes when the fd was closed while a thread was
+waiting on the fd (since it's very unsafe to read/write an fd that is closed or
+worse: has been recycled to refer to a different file).
+
+The synchronous success and failure cases are handled by the initiating
+primops. In the blocking case, it relies on one of these stg_block_ functions,
+stack frames, and stack frame info table entry code. The key bits of the
+mechanism are:
+
+ - The stg_block_ cmm function sets up the stack frame for the blocked thread.
+ - The stack frame entries can be overwritten by the I/O manager, e.g. upon I/O
+ completion or error.
+ - The stack frame's info table entry code is invoked when the thread is
+ resumed.
+ - The entries in the stack frame become arguments to the info table entry code.
+ - The result(s) returned by the info table entry code _are_ the result(s) of
+ the I/O primop.
+
+It is important to keep clear the distinction between the stack frame entries
+and the final primop result(s): the stack frame's info table entry code
+transforms the former into the latter.
+
+The convention we follow is that the stack frame contains two fields:
+ - an outcome, using IOOpOutcome values: in-flight, success, failed, cancelled.
+ - a result or error code. For outcome success it is a result. For failed it is
+ the error code (using posix errno codes), while for cancelled and in-flight
+ outcomes there is no result.
+
+This outcome+result/failure encoding is exactly the same as the corresponding
+fields in the StgAsyncIOOp. One day we might just use the StgAsyncIOOp itself,
+once all I/O managers use them.
+
+The waitRead/waitWrite# primops do not use a result, but later I/O primops will
+do. In particular read/write on files return a length, and other I/O primitives
+also have a single result.
+
+So this gives us two block functions and corresponding info tables:
+
+ 1. stg_block_io_unit: with a stack frame containing outcome+result/failure.
+ On resume, throw exception on failure and otherwise return no args.
+ This is for primops with result IO ().
+
+ 2. stg_block_io_int: with a stack frame containing outcome+result/failure.
+ On resume, throw exception on failure and otherwise return result.
+ This is for primops with result IO Int or IO Word.
+
+ 3. stg_block_io_aiop: in future if we add async I/O primitives that return an
+ StgAsyncIOOp we would also need versions that return that (since even
+ submitting async I/O can block if there's too much I/O in flight).
+
+The stack frame layout used is:
+ Sp[0] stg_block_io_unit_info or stg_block_io_int_info
+ Sp[1] outcome
+ Sp[2] result or error
+
+C code should use setTsoIOOpOutcome to set this. But update this if the layout
+changes!
+
+
+Note [Calling convention for raisePrimIOException]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+In cases 1 & 2 we check the outcome and, on failure, we throw an exception. Our
+approach is to use a helper function implemeted in generated Haskell code, in
+ghc-internal. We need to perform a tail call to this helper function:
+
+ raisePrimIOException :: Int# -> State# s -> (# State# s, a #)
+
+The calling convention for top-level generated Haskell function like this uses
+R2 because it has two arguments -- the Int# and State# -- but the State#
+argument has a zero-width repesentation. The cmm call uses R1, R2, ... etc so
+to pass in R2 we have to use a dummy first argument which will be passed in R1
+(and ignored).
+*/
+
+/* stg_block_io_unit_info : the return info table for stg_block_io_unit */
+INFO_TABLE_RET ( stg_block_io_unit, RET_SMALL, W_ info_ptr,
+ W_ outcome, W_ result )
+ return ()
{
- // When blocking on an MVar we have to be careful to only release
- // the lock on the MVar at the very last moment (using
- // BLOCK_BUT_FIRST()), since when we release the lock another
- // Capability can wake up the thread, which modifies its stack and
- // other state. This is not a problem for STM, because STM
- // wakeups are non-destructive; the waker simply calls
- // tryWakeupThread() which sends a message to the owner
- // Capability. So the moment we release this lock we might start
- // getting wakeup messages, but that's perfectly harmless.
- //
- // Furthermore, we *must* release these locks, just in case an
- // exception is raised in this thread by
- // maybePerformBlockedException() while exiting to the scheduler,
- // which will abort the transaction, which needs to obtain a lock
- // on all the TVars to remove the thread from the queues.
- //
- ccall stmWaitUnlock(MyCapability() "ptr", R3 "ptr");
+ if (outcome == 2 :: W_ /*IOOpOutcomeFailed*/) (likely: False) {
+ /* See Note [Calling convention for raisePrimIOException] */
+ W_ dummyR1;
+ dummyR1 = 0;
+ jump %ENTRY_CODE(HsIface_raisePrimIOException_info(W_[ghc_hs_iface]))
+ (dummyR1, result);
+ } else {
+ /* success or cancelled outcomes */
+ return ();
+ }
+}
+
+/* Blocking for I/O primops with result IO ().
+ * See Note [Thread blocking for new I/O primops].
+ */
+stg_block_io_unit
+{
+ /* Fill out the stack frame with dummy values. The IO manager will
+ * overwrite these with the actual results when the I/O operation
+ * completes, fails, or is cancelled.
+ */
+ Sp_adj(-3);
+ Sp(0) = stg_block_io_unit_info;
+ Sp(1) = 0; // outcome: 0 indicates IOOpOutcomeInFlight
+ Sp(2) = 0; // result/errno
+ BLOCK_GENERIC;
+}
+
+/* stg_block_io_int_info : the return info table for stg_block_io_int */
+INFO_TABLE_RET ( stg_block_io_int, RET_SMALL, W_ info_ptr,
+ W_ outcome, W_ result )
+ return ()
+{
+ if (outcome == 2 :: W_ /*IOOpOutcomeFailed*/) (likely: False) {
+ /* See Note [Calling convention for raisePrimIOException] */
+ W_ dummyR1;
+ dummyR1 = 0;
+ jump %ENTRY_CODE(HsIface_raisePrimIOException_info(W_[ghc_hs_iface]))
+ (dummyR1, result);
+ } else {
+ /* success or cancelled outcomes */
+ return (result);
+ }
+}
+
+/* Blocking for I/O primops with result IO Int or Word (or rather Int#/Word#).
+ * See Note [Thread blocking for new I/O primops].
+ */
+stg_block_io_int
+{
+ /* Fill out the stack frame with dummy values. The IO manager will
+ * overwrite these with the actual results when the I/O operation
+ * completes, fails, or is cancelled.
+ */
+ Sp_adj(-3);
+ Sp(0) = stg_block_io_int_info;
+ Sp(1) = 0; // outcome: 0 indicates IOOpOutcomeInFlight
+ Sp(2) = 0; // result/errno
BLOCK_GENERIC;
}
=====================================
rts/IOManager.c
=====================================
@@ -399,21 +399,6 @@ void startIOManager(void)
switch (iomgr_type) {
-#if defined(IOMGR_ENABLED_SELECT) || defined(IOMGR_ENABLED_POLL)
-#if defined(IOMGR_ENABLED_SELECT)
- case IO_MANAGER_SELECT:
-#endif
-#if defined(IOMGR_ENABLED_POLL)
- case IO_MANAGER_POLL:
-#endif
- /* Make the exception CAF a GC root. See initBuiltinGcRoots for
- * similar examples. We throw this exception if a thread tries to
- * wait on an invalid FD.
- */
- getStablePtr((StgPtr)blockedOnBadFD_closure);
- break;
-#endif
-
#if defined(IOMGR_ENABLED_MIO_POSIX)
case IO_MANAGER_MIO_POSIX:
/* Posix implementation in posix/Signals.c
@@ -776,10 +761,10 @@ void interruptIOManager(CapIOManager *iomgr)
/* CMM primop. Result is true on success, or false on allocation failure. */
-bool syncIOWaitReady(CapIOManager *iomgr,
- StgTSO *tso,
- IOReadOrWrite rw,
- HsInt fd)
+IOSubmitResult syncIOWaitReady(CapIOManager *iomgr,
+ StgTSO *tso,
+ IOReadOrWrite rw,
+ HsInt fd)
{
debugTrace(DEBUG_iomanager,
"thread %ld waiting for %s I/O readiness on fd %d",
@@ -795,7 +780,7 @@ bool syncIOWaitReady(CapIOManager *iomgr,
tso->block_info.fd = fd;
appendToIOBlockedQueue(iomgr, tso);
RELEASE_STORE(&tso->why_blocked, why_blocked);
- return true;
+ return IOSubmitResultAsyncContinue;
}
#endif
#if defined(IOMGR_ENABLED_POLL)
=====================================
rts/IOManager.h
=====================================
@@ -325,8 +325,33 @@ typedef enum { IORead = 0, IOWrite = 1 } IOReadOrWrite;
* false on heap allocation failure.
*/
+/* Note [Encoding of result of I/O manager operations]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We have quite a bit of information that to return from the I/O manager calls
+back to the I/O primops. It (somewhat uncomfortably) fits into a C int.
+
+We use the following encoding of the result:
+
+ * negative: synchronous failure, with -errno as the result.
+ * 0: ok, result successful, proceed to async: suspend the TSO.
+ * 1: synchronous success, return without suspending the TSO. This can occur
+ for example when waiting on readiness of a regular file (which is always
+ ready).
+ * 2: heap overflow
+ * >2: unallocated status codes
+*/
+typedef int IOSubmitResult;
+
+/* Provide constants for IOSubmitResult */
+enum IOSubmitResultCodes {
+ /* negative numbers are -errno error codes */
+ IOSubmitResultAsyncContinue = 0,
+ IOSubmitResultSyncSuccess = 1,
+ IOSubmitResultHeapOverflow = 2
+};
+
/* Called from CMM primop */
-bool syncIOWaitReady(CapIOManager *iomgr, StgTSO *tso, IOReadOrWrite rw, HsInt fd);
+IOSubmitResult syncIOWaitReady(CapIOManager *iomgr, StgTSO *tso, IOReadOrWrite rw, HsInt fd);
void syncIOCancel(CapIOManager *iomgr, StgTSO *tso);
=====================================
rts/IOManagerInternals.h
=====================================
@@ -81,5 +81,25 @@ struct _CapIOManager {
};
+/* Fill in the outcome and result/error on the TSO's stack frame.
+ * The TSO must be blocked using one of the stg_block_io_* blocking actions.
+ *
+ * Once the thread is resumed (by the scheduler) the code for stg_block_*_info
+ * will pick up the info from the stack frame and use it to see if there's been
+ * a failure, and if so to raise a PrimIOException.
+ *
+ * See Note [Thread blocking for new I/O primops].
+ */
+INLINE_HEADER void setTsoIOOpOutcome (StgTSO *tso,
+ enum IOOpOutcome outcome,
+ uint32_t result)
+{
+ ASSERT((StgPtr *)tso->stackobj->sp[0] == (StgPtr *)&stg_block_io_unit_info
+ || (StgPtr *)tso->stackobj->sp[0] == (StgPtr *)&stg_block_io_int_info);
+
+ tso->stackobj->sp[1] = (W_)outcome;
+ tso->stackobj->sp[2] = (W_)result;
+}
+
#include "EndPrivate.h"
=====================================
rts/Prelude.h
=====================================
@@ -65,8 +65,6 @@ extern StgClosure ZCMain_main_closure;
#define overflowException_closure ghc_hs_iface->overflowException_closure
#define divZeroException_closure ghc_hs_iface->divZZeroException_closure
-#define blockedOnBadFD_closure ghc_hs_iface->blockedOnBadFD_closure
-
#define Czh_con_info ghc_hs_iface->Czh_con_info
#define Izh_con_info ghc_hs_iface->Izh_con_info
#define Fzh_con_info ghc_hs_iface->Fzh_con_info
=====================================
rts/PrimOps.cmm
=====================================
@@ -2297,32 +2297,60 @@ stg_whereFromzh (P_ clos, W_ buf)
Thread I/O blocking primitives
-------------------------------------------------------------------------- */
-stg_waitReadzh ( W_ fd )
+stg_handleIOSubmitResult ( CInt result )
{
- CBool ok; /* Ok, or heap alloc failure. */
+ /* See Note [Encoding of result of I/O manager operations] */
- (ok) = ccall syncIOWaitReady(Capability_iomgr(MyCapability()) "ptr",
- CurrentTSO "ptr",
- /* IORead */ 0::CInt, fd);
- if (ok != 0::CBool) (likely: True) {
- jump stg_block_noregs();
- } else {
+ /* case IOSubmitResultAsyncContinue */
+ if (result == 0::CInt) (likely: True) {
+ /* See Note [Thread blocking for new I/O primops] */
+ jump stg_block_io_unit();
+ }
+
+ /* case IOSubmitResultSyncSuccess*/
+ if (result == 1::CInt) (likely: True) {
+ /* Success, don't even go via scheduler. */
+ return ();
+ }
+
+ /* negative numbers are -errno error codes */
+ if (result < 0::CInt) {
+ /* See Note [Calling convention for raisePrimIOException] */
+ W_ dummyR1; W_ errno;
+ dummyR1 = 0;
+ errno = TO_W_(-result);
+ jump %ENTRY_CODE(HsIface_raisePrimIOException_info(W_[ghc_hs_iface]))
+ (dummyR1, errno);
+ }
+
+ /* case IOSubmitResultHeapOverflow */
+ if (result == 2::CInt) {
jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface]));
+
}
+ ccall sbarf("syncIOWaitReady result encoding error") never returns;
+}
+
+stg_waitReadzh ( W_ fd )
+{
+ CInt result;
+
+ (result) = ccall syncIOWaitReady(Capability_iomgr(MyCapability()) "ptr",
+ CurrentTSO "ptr",
+ /* IORead */ 0::CInt, fd);
+
+ jump stg_handleIOSubmitResult(result);
}
stg_waitWritezh ( W_ fd )
{
- CBool ok; /* Ok, or heap alloc failure. */
+ CInt result;
- (ok) = ccall syncIOWaitReady(Capability_iomgr(MyCapability()) "ptr",
- CurrentTSO "ptr",
- /* IOWrite */ 1::CInt, fd);
- if (ok != 0::CBool) (likely: True) {
- jump stg_block_noregs();
- } else {
- jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface]));
- }
+ (result) = ccall syncIOWaitReady(Capability_iomgr(MyCapability()) "ptr",
+ CurrentTSO "ptr",
+ /* IOWrite */ 1::CInt, fd);
+
+ jump stg_handleIOSubmitResult(result);
}
stg_delayzh ( W_ us_delay )
=====================================
rts/include/rts/RtsToHsIface.h
=====================================
@@ -28,7 +28,7 @@ typedef struct {
StgClosure *nonTermination_closure; // GHC.Internal.Control.Exception.Base.nonTermination_closure
StgClosure *nestedAtomically_closure; // GHC.Internal.Control.Exception.Base.nestedAtomically_closure
StgClosure *noMatchingContinuationPrompt_closure; // GHC.Internal.Control.Exception.Base.noMatchingContinuationPrompt_closure
- StgClosure *blockedOnBadFD_closure; // GHC.Internal.Event.Thread.blockedOnBadFD_closure
+ StgClosure *raisePrimIOException_info; // GHC.Internal.Conc.IO.raisePrimIOException_info
StgClosure *runSparks_closure; // GHC.Internal.Conc.Sync.runSparks_closure
StgClosure *ensureIOManagerIsRunning_closure; // GHC.Internal.Conc.IO.ensureIOManagerIsRunning_closure
StgClosure *interruptIOManager_closure; // GHC.Internal.Conc.IO.interruptIOManager_closure
=====================================
rts/include/stg/MiscClosures.h
=====================================
@@ -369,6 +369,7 @@ RTS_FUN_DECL(stg_gc_bpp);
RTS_RET(stg_gc_fun);
RTS_FUN_DECL(__stg_gc_fun);
+/* Blocking for various primops */
RTS_FUN_DECL(stg_yield_noregs);
RTS_FUN_DECL(stg_yield_to_interpreter);
RTS_FUN_DECL(stg_block_noregs);
@@ -380,13 +381,19 @@ RTS_RET(stg_block_takemvar);
RTS_RET(stg_block_readmvar);
RTS_FUN_DECL(stg_block_putmvar);
RTS_RET(stg_block_putmvar);
+RTS_FUN_DECL(stg_block_stmwait);
+RTS_FUN_DECL(stg_block_throwto);
+RTS_RET(stg_block_throwto);
+
+/* Blocking for I/O primops */
+RTS_FUN_DECL(stg_block_io_unit);
+RTS_RET(stg_block_io_unit);
+RTS_FUN_DECL(stg_block_io_int);
+RTS_RET(stg_block_io_int);
#if defined(mingw32_HOST_OS)
RTS_FUN_DECL(stg_block_async);
RTS_RET(stg_block_async);
#endif
-RTS_FUN_DECL(stg_block_stmwait);
-RTS_FUN_DECL(stg_block_throwto);
-RTS_RET(stg_block_throwto);
/* Entry/exit points from StgStartup.cmm */
=====================================
rts/posix/Poll.c
=====================================
@@ -20,7 +20,6 @@
#include "Prelude.h"
#include "RtsUtils.h"
#include "rts/Time.h"
-#include "RaiseAsync.h"
#include "Trace.h"
#include "Poll.h"
@@ -171,14 +170,13 @@ void freeCapabilityIOManagerPoll(CapIOManager *iomgr)
}
-/* Used to implement syncIOWaitReady.
- * Result is true on success, or false on allocation failure. */
-bool syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso,
- IOReadOrWrite rw, HsInt fd)
+/* Used to implement syncIOWaitReady. */
+IOSubmitResult syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso,
+ IOReadOrWrite rw, HsInt fd)
{
StgAsyncIOOp *aiop;
aiop = (StgAsyncIOOp *)allocateMightFail(iomgr->cap, sizeofW(StgAsyncIOOp));
- if (RTS_UNLIKELY(aiop == NULL)) return false;
+ if (RTS_UNLIKELY(aiop == NULL)) return IOSubmitResultHeapOverflow;
SET_HDR(aiop, &stg_ASYNCIOOP_info, iomgr->cap->r.rCCCS);
aiop->notify.tso = tso;
aiop->notify_type = NotifyTSO;
@@ -189,13 +187,12 @@ bool syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso,
return asyncIOWaitReadyPoll(iomgr, aiop, rw, fd);
}
-/* Result is true on success, or false on allocation failure. */
-bool asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop,
- IOReadOrWrite rw, int fd)
+IOSubmitResult asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop,
+ IOReadOrWrite rw, int fd)
{
if (RTS_UNLIKELY(isFullClosureTable(&iomgr->aiop_table))) {
bool ok = enlargeTables(iomgr);
- if (RTS_UNLIKELY(!ok)) return false;
+ if (RTS_UNLIKELY(!ok)) return IOSubmitResultHeapOverflow;
}
int ix = insertClosureTable(iomgr->cap, &iomgr->aiop_table, aiop);
@@ -216,7 +213,7 @@ bool asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop,
.events = rw == IORead ? POLLIN : POLLOUT,
.revents = 0
};
- return true;
+ return IOSubmitResultAsyncContinue;
}
@@ -226,6 +223,7 @@ void syncIOCancelPoll(CapIOManager *iomgr, StgTSO *tso)
ASSERT(aiop->notify_type == NotifyTSO);
ASSERT(indexClosureTable(&iomgr->aiop_table, aiop->index) == aiop);
ioCancel(iomgr, aiop);
+ setTsoIOOpOutcome(tso, aiop->outcome, aiop->result);
/* We cannot use the normal notifyIOCompletion here. We are in the context
* of throwTo, interrupting a thread blocked on IO via an async exception.
* We don't put the TSO back on the run queue or change the why_blocked
@@ -284,26 +282,18 @@ static void notifyIOCompletion(CapIOManager *iomgr, StgAsyncIOOp *aiop)
switch (aiop->notify_type) {
case NotifyTSO:
{
- if (aiop->outcome == IOOpOutcomeFailed && aiop->error == EBADF) {
- /* The fd is invalid: raise an IOError exception in the blocked
- * thread. (See bug #4934 for what happens without this.)
- */
- StgTSO *tso = aiop->notify.tso;
- debugTrace(DEBUG_iomanager,
- "Raising exception in thread %" FMT_StgThreadID
- " blocked on an invalid fd", tso->id);
- raiseAsync(iomgr->cap, tso,
- (StgClosure *)blockedOnBadFD_closure,
- false, NULL);
- } else {
- /* We should be guaranteed that the tso is still on the same
- * cap because the tso was not on the run queue of any cap and
- * so is not subject to thread migration.
- */
- StgTSO *tso = aiop->notify.tso;
- pushOnRunQueue(iomgr->cap, tso);
- RELEASE_STORE(&tso->why_blocked, NotBlocked);
- }
+ /* We should be guaranteed that the tso is still on the same
+ * cap because the tso was not on the run queue of any cap and
+ * so is not subject to thread migration.
+ */
+ StgTSO *tso = aiop->notify.tso;
+ ASSERT(tso->cap == iomgr->cap);
+
+ /* Fill in the outcome and result/error on the TSO's stack frame */
+ setTsoIOOpOutcome(tso, aiop->outcome, aiop->result);
+ pushOnRunQueue(iomgr->cap, tso);
+ RELEASE_STORE(&tso->why_blocked, NotBlocked);
+
/* For the TSO case, the aiop was only reachable from the TSO
* itself, and thus it is now no longer be reachable at all.
*/
=====================================
rts/posix/Poll.h
=====================================
@@ -20,13 +20,13 @@ void initCapabilityIOManagerPoll(CapIOManager *iomgr);
void freeCapabilityIOManagerPoll(CapIOManager *iomgr);
/* Synchronous I/O and timer operations */
-bool syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso,
- IOReadOrWrite rw, HsInt fd);
+IOSubmitResult syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso,
+ IOReadOrWrite rw, HsInt fd);
void syncIOCancelPoll(CapIOManager *iomgr, StgTSO *tso);
/* Asynchronous operations */
-bool asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop,
- IOReadOrWrite rw, int fd);
+IOSubmitResult asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop,
+ IOReadOrWrite rw, int fd);
void asyncIOCancelPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop);
/* Scheduler operations */
=====================================
rts/posix/Select.c
=====================================
@@ -15,7 +15,6 @@
#include "Signals.h"
#include "Schedule.h"
#include "Prelude.h"
-#include "RaiseAsync.h"
#include "RtsUtils.h"
#include "Capability.h"
#include "Select.h"
@@ -480,13 +479,18 @@ awaitCompletedTimeoutsOrIOSelect(CapIOManager *iomgr, bool wait)
IF_DEBUG(scheduler,
debugBelch("Killing blocked thread %" FMT_StgThreadID
" on bad fd=%i\n", tso->id, fd));
- raiseAsync(iomgr->cap, tso,
- (StgClosure *)blockedOnBadFD_closure, false, NULL);
+
+ /* Fill in the outcome and error on the TSO's stack frame */
+ setTsoIOOpOutcome(tso, IOOpOutcomeFailed, EBADF);
+ pushOnRunQueue(iomgr->cap,tso);
+ RELEASE_STORE(&tso->why_blocked, NotBlocked);
break;
case RTS_FD_IS_READY:
IF_DEBUG(scheduler,
debugBelch("Waking up blocked thread %" FMT_StgThreadID "\n",
tso->id));
+ /* Fill in the outcome and result on the TSO's stack frame */
+ setTsoIOOpOutcome(tso, IOOpOutcomeSuccess, 0);
pushOnRunQueue(iomgr->cap,tso);
RELEASE_STORE(&tso->why_blocked, NotBlocked);
break;
=====================================
utils/deriveConstants/Main.hs
=====================================
@@ -644,6 +644,7 @@ wanteds os = concat
,structField C "HsIface" "divZZeroException_closure"
,structField C "HsIface" "underflowException_closure"
,structField C "HsIface" "overflowException_closure"
+ ,structField C "HsIface" "raisePrimIOException_info"
,structField C "HsIface" "unpackCStringzh_info"
,structField C "HsIface" "unpackCStringUtf8zh_info"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8b2bd8fa07a421da6d62d2c01743e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8b2bd8fa07a421da6d62d2c01743e…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/sjakobi/T27776-t26537-timeout] testsuite: Give T26537 a 1.5x compile timeout
by Simon Jakobi (＠sjakobi) 10 Sep '26
by Simon Jakobi (＠sjakobi) 10 Sep '26
10 Sep '26
Simon Jakobi pushed to branch wip/sjakobi/T27776-t26537-timeout at Glasgow Haskell Compiler / GHC
Commits:
d9c6e348 by Simon Jakobi at 2026-09-10T01:34:35+02:00
testsuite: Give T26537 a 1.5x compile timeout
Its -fregs-graph compile step tends to time out in unoptimized builds
(#27188, #27776).
Assisted-by: Claude Fable 5.1
- - - - -
1 changed file:
- testsuite/tests/codeGen/should_run/all.T
Changes:
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -258,7 +258,7 @@ test('T24893', normal, compile_and_run, ['-O'])
test('CCallConv', [req_c], compile_and_run, ['CCallConv_c.c'])
test('T25364', normal, compile_and_run, [''])
test('T26061', normal, compile_and_run, [''])
-test('T26537', normal, compile_and_run, ['-O2 -fregs-graph'])
+test('T26537', compile_timeout_multiplier(1.5), compile_and_run, ['-O2 -fregs-graph'])
test('T24016', normal, compile_and_run, ['-O1 -fPIC'])
test('T27046',
[ req_cmm
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9c6e348018c927105fd88b255075e5…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9c6e348018c927105fd88b255075e5…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/sjakobi/T12934-line-buffer-stdout] testsuite: Line-buffer the driver's stdout
by Simon Jakobi (＠sjakobi) 10 Sep '26
by Simon Jakobi (＠sjakobi) 10 Sep '26
10 Sep '26
Simon Jakobi pushed to branch wip/sjakobi/T12934-line-buffer-stdout at Glasgow Haskell Compiler / GHC
Commits:
66e488ae by Simon Jakobi at 2026-09-10T01:01:59+02:00
testsuite: Line-buffer the driver's stdout
Python block-buffers stdout when it is a pipe. This is the case for
example in CI. As a result there is often no indication of progress at
all until the run ends.
To fix this, we configure it explicitly to use line buffering instead.
stderr is reconfigured too, for consistency: Python line-buffers it by
default since 3.9.
The type-ignores are for mypy, which types these handles as TextIO — an
interface without reconfigure.
Fixes #12934.
Assisted-by: Claude Fable 5
- - - - -
1 changed file:
- testsuite/driver/runtests.py
Changes:
=====================================
testsuite/driver/runtests.py
=====================================
@@ -38,6 +38,12 @@ import term_color
from term_color import Color, colored
import cpu_features
+# Line-buffer stdout: when it is a pipe (as in CI), the block-buffered
+# default delays test and progress output (#12934). stderr is included
+# for consistency, although Python line-buffers it by default since 3.9.
+sys.stdout.reconfigure(line_buffering=True) # type: ignore[union-attr]
+sys.stderr.reconfigure(line_buffering=True) # type: ignore[union-attr]
+
# Readline sometimes spews out ANSI escapes for some values of TERM,
# which result in test failures. Thus set TERM to a nice, simple, safe
# value.
@@ -352,8 +358,6 @@ try:
except Exception as e:
print('Failed to detect CPU features: ', e)
-sys.stdout.flush()
-
if config.local:
tempdir = ''
else:
@@ -518,9 +522,6 @@ else:
except KeyboardInterrupt:
pass
- # flush everything before we continue
- sys.stdout.flush()
-
# Dump metrics data.
print("\nPerformance Metrics (test environment: {}):\n".format(config.test_env))
if config.baseline_commit:
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66e488aee2c475d18c23f2fd2bf0a01…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66e488aee2c475d18c23f2fd2bf0a01…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/az/exactprint-main-loop-note] EPA: Add a Note for the exact print main loop
by Alan Zimmerman (＠alanz) 10 Sep '26
by Alan Zimmerman (＠alanz) 10 Sep '26
10 Sep '26
Alan Zimmerman pushed to branch wip/az/exactprint-main-loop-note at Glasgow Haskell Compiler / GHC
Commits:
08741965 by Alan Zimmerman at 2026-09-09T23:08:59+01:00
EPA: Add a Note for the exact print main loop
- - - - -
1 changed file:
- utils/check-exact/ExactPrint.hs
Changes:
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -140,9 +140,9 @@ defaultEPState = EPState
-- | The R part of RWS. The environment. Updated via 'local' as we
-- enter a new AST element, having a different anchor point.
-data EPOptions m a = EPOptions
- { epTokenPrint :: String -> m a
- , epWhitespacePrint :: String -> m a
+data EPOptions m w = EPOptions
+ { epTokenPrint :: String -> m w
+ , epWhitespacePrint :: String -> m w
}
-- | Helper to create a 'EPOptions'
@@ -163,8 +163,7 @@ stringOptions = epOptions return return
deltaOptions :: EPOptions Identity ()
deltaOptions = epOptions (\_ -> return ()) (\_ -> return ())
-data EPWriter a = EPWriter
- { output :: !a }
+data EPWriter w = EPWriter { output :: !w }
instance Monoid w => Semigroup (EPWriter w) where
(EPWriter a) <> (EPWriter b) = EPWriter (a <> b)
@@ -239,7 +238,220 @@ setAnchorEpaL (EpAnn _ an _) anc ts cs = EpAnn anc (setTrailing (an {al_anchor =
-- | Key entry point. Switches to an independent AST element with its
-- own annotation, calculating new offsets, etc
markAnnotated :: (Monad m, Monoid w, ExactPrint a) => a -> EP w m a
-markAnnotated a = enterAnn (getAnnotationEntry a) a
+markAnnotated a = enterAnn (getAnnotationEntry a) a -- See Note [Exact print main loop]
+
+{-
+Note [Exact print main loop]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Exact printing is the process of taking the ParsedSource, or some
+subtree from it, and rendering it to a string, which accurately
+reflects the original source that was parsed, except detail of
+whitespace (such as spaces vs tabs) is discarded.
+
+The ParsedSource or fragment from it must implement the ExactPrint
+class, and this file does that, as well as supporting machinery to
+drive the process. The ExactPrint class is described later in this
+note.
+
+The entry point for exact printing is the exactPrint function, defined
+as
+
+ exactPrint :: ExactPrint ast => ast -> String
+ exactPrint ast = snd $ runIdentity (runEP stringOptions (markAnnotated ast))
+
+ type EP w m a = RWST (EPOptions m w) (EPWriter w) EPState m a
+
+ runEP :: (Monad m) => EPOptions m w -> EP w m a -> m (a, w)
+ runEP epReader action = do
+ (ast, w) <- evalRWST action epReader defaultEPState
+ return (ast, output w)
+
+ data EPWriter w = EPWriter { output :: !w }
+
+ data EPOptions m w = EPOptions
+ { epTokenPrint :: String -> m w
+ , epWhitespacePrint :: String -> m w
+ }
+
+This offers some flexibility in how the output is produced, in that
+the EpWriter and EPOptions work together, defining an output type and
+a function to render whitespace and non-whitepace.
+
+In normal operation (via exactPrint) these are simply returning the
+string unchanged and accumulating a larger string. But it has also been
+used to render an HTML version of the source as it prints.
+
+The main reason exact print exists is to make it easier for tool
+writers to manipulate the ParsedSource, and render this back to the
+original source, except for the changed parts. One manipulation is to
+simply take say a FunBind with its signature from one place in the
+code to another. When doing this, the original parsed locations are no
+longer useful when rendering the source back to a string. To enable
+this, we have another entry point, for converting all absolute
+locations to relative ones, using DeltaPos, which captures the line
+and col offset relative to the prior output.
+
+The function to do this is
+
+ makeDeltaAst :: ExactPrint ast => ast -> ast
+ makeDeltaAst ast = fst $ runIdentity (runEP deltaOptions (markAnnotated ast))
+
+The implementation is practically identical for exactPrint and
+makeDeltaAst, they simply return the second or first part of the same
+calculation.
+
+This simplifies the implementation of the required ExactPrint
+implmentations, in that we only need one per ast item, which encodes
+how to print it, and this print process does bookkeeping to keep track
+of what spacing it used when doing the print, so it can return the
+updated item, with the original absolute SrcSpan's converted to
+DeltaPos values instead.
+
+This information is captured in the XRec/Anno instances used in GHC
+Hs, which are mostly LocatedA a, defined as
+
+ GenLocated (EpAnn [TrailingAnn]) a
+
+ data EpAnn ann
+ = EpAnn { entry :: !EpaLocation
+ , anns :: !ann
+ , comments :: !EpAnnComments
+ }
+
+ data EpaLocation = EpaSpan !SrcSpan
+ | EpaDelta !SrcSpan !DeltaPos [LEpaComment]
+
+When parsed, the entry EpaLocation captures an EpaSpan with the parsed
+absolute location. After makeDeltaAst, this instead uses EpaDelta,
+including the original SrcSpan, the relative spaceing as a DeltaPos,
+and any comments that may come before the item, e.g. comments before a
+semicolon.
+
+Both exactPrint and makeDeltaAst call markAnnotated on the item to be
+printed, inside the monad machinery.
+
+ markAnnotated :: (Monad m, Monoid w, ExactPrint a) => a -> EP w m a
+ markAnnotated a = enterAnn (getAnnotationEntry a) a
+
+This makes use of the ExactPrint instance for the ParsedSource and
+for every other part of the ParsedSource as a tree.
+
+ class (Typeable a) => ExactPrint a where
+ getAnnotationEntry :: a -> Entry
+ exact :: (Monad m, Monoid w) => a -> EP w m a
+ setAnnotationAnchor :: a -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> a
+
+- getAnnotationEntry : returns the Entry information, normally derived
+ directly from the EpAnn in the LocatedA enclosing the item.
+ Entry contains
+ - The location of the first non-comment part of the item to be printed.
+ - Any [TrailingAnn] (semis, commas, etc) to follow the item.
+ - Any comments associated with the item, but not with enclosed items.
+ These comments may also precede or follow the entry location
+ - Some technical flags, relating to flushing remaining comments at the
+ last (topmost) item, and if the anchor can be updated (see below).
+
+- exact : Do the actual printing of the item, having been put in the right
+ place in terms of print location by the main loop, based on a call to
+ getAnnotationEntry for it. This printing normally comprises making nested
+ markAnnotated calls on the nested items in the current one, e.g.
+
+ exact (HsApp an e1 e2) = do
+ e1' <- markAnnotated e1
+ e2' <- markAnnotated e2
+ return (HsApp an e1' e2')
+
+- setAnnotationAnchor : the main loop printing does two things:
+ - produce output, reflecting the items being printed
+ - convert all the locations in the item (each an EpaLocation) from its
+ EpaSpan version to an EpaDelta one, which is independent of absolute
+ location, being the spacing from the previous print output to this
+ entry point
+ To allow these updated locations to be captured, the item implements
+ the setAnnotationAnchor method, which updates the fields of the Entry
+ returned by getAnnotationEntry
+
+You will recall
+
+ markAnnotated a = enterAnn (getAnnotationEntry a) a
+ enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a
+
+enterAnn is the part that is repeatedly called via markAnnotated, to
+manage the bookkeeping around printing and calculating the updated
+delta positions.
+
+It manages the printing state, adding the new comments from the Entry,
+positioning the print head to the entry point, takes account of whether
+it is an absolute span or a delta, and prints any comments that must come
+before this location.
+
+At this print location, it calls the `exact` method on the item. This
+is the only place `exact` can be called. Within `exact` implementations
+the `markAnnotated` function should be used instead, to ensure the state
+is managed properly for printing.
+
+Once the item is printed via its `exact` method, which normally
+recurses via `markAnnotated` into any nested items inside it, the
+`enterAnn` function prints any [TrailingAnn] from the entry and any
+trailing comments. It then wraps up by calling
+`setAnnotationAnchor`with the updated (now delta-based) values for the
+Entry
+
+Printing Complicated Items
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+Sometimes we need to print a sub-item which does not map cleanly onto the
+ExactPrint class, usually because there are parts spread through the item
+that need to be managed together while printing.
+
+An example is in
+https://gitlab.haskell.org/ghc/ghc/-/merge_requests/16321, where
+ConDeclGADT needs to print its inner_bindings, but the these in turn
+may have parens, e.g.
+
+ data V a where
+ MkV4 :: forall a. ((forall b. (Show a => a -> (b -> V a))))
+
+Here there are inner bindings for the first forall, the multiple
+parens around the second forall, and the second forall, wrapping the
+inner content within this.
+
+But the inner content `Show a => a -> (b -> V a)` had to be printed "inside"
+the inner_bindings, to correctly close the nested parens.
+
+The approach in !16321 modified `enterAnn`, to pass in alternate versions
+of the `exact` implementation. This works, but it makes an already
+complicated function even more complicated.
+
+An ExactPrint-idiomatic approach is to create a helper data structure
+to represent this nested organisation, and provide ExactPrint
+instances for that.
+
+This is done in
+https://gitlab.haskell.org/ghc/ghc/-/merge_requests/16644, using
+
+ data InnerBindings
+ = InnerMore (LHsGadtTelescope GhcPs) InnerBindings
+ | InnerDone (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs)
+
+The key part of the ExactPrint instance for this is
+
+ exact (InnerMore (L l (HsGadtPar (lp, rp))) xs) = do
+ lp' <- markEpToken lp
+ xs' <- markAnnotated xs
+ rp' <- markEpToken rp
+ return (InnerMore (L l (HsGadtPar (lp',rp'))) xs')
+
+This first prints the opening paren, prints the balance of the cons list, then
+prints the closing paren.
+
+Conversions to and from this structure populate the initial values from
+the ConDeclGADT, and retrieve the updated delta-based values after
+printing.
+
+Another use of this technique involves HsModuleImpDecls.
+
+-}
-- | For HsModule, because we do not have a proper SrcSpan, we must
-- indicate to flush trailing comments when done.
@@ -377,6 +589,7 @@ cua NoCanUpdateAnchor _ = return []
-- This is combination of the ghc=exactprint Delta.withAST and
-- Print.exactPC functions and effectively does the delta processing
-- immediately followed by the print processing. JIT ghc-exactprint.
+-- See Note [Exact print main loop]
enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a
enterAnn NoEntryVal a = do
p <- getPosP
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/08741965280a44feb53e6627f98de26…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/08741965280a44feb53e6627f98de26…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: Reorder cmm decls in HeapStackCheck for a better logical grouping
by Marge Bot (＠marge-bot) 09 Sep '26
by Marge Bot (＠marge-bot) 09 Sep '26
09 Sep '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
430967ab by Duncan Coutts at 2026-09-09T11:07:01+01:00
Reorder cmm decls in HeapStackCheck for a better logical grouping
And put more section headers in to deliniate the groups.
We're about to add more here, so better to organise it first.
- - - - -
344080fd by Duncan Coutts at 2026-09-09T11:07:01+01:00
Add raisePrimIOException and add it to RTS<->ghc-internal API
The raisePrimIOException is a new helper function that I/O primops will
use to help them report I/O errors. This is implemented in Haskell
(since that's a lot easier), but has a calling convention that is
easy(ish) to use from Cmm in the I/O primops.
So we add it to the RTS API struct, and since we'll use it from Cmm we
also need a field accessor macro for cmm (in deriveConstants).
See the Note about how we cannot have nice things due to async
exceptions and thunks preventing us from using catch.
- - - - -
cfdb3399 by Duncan Coutts at 2026-09-09T11:07:01+01:00
Add new blocking functions for I/O primops
See the Note [Thread blocking for new I/O primops],
and the Note [Calling convention for raisePrimIOException].
The point is, it will allow us to report synchronous exceptions from I/O
primops, and do so much more flexibly.
Previously the I/O managers could only report async exceptions and only
nullary exceptions. This was OK historically, but no good as we add
more I/O managers and expand the range of I/O operations we support.
- - - - -
f09c09d8 by Duncan Coutts at 2026-09-09T11:07:01+01:00
Change the encoding of results from the I/O manager to I/O primops
Previously we just had async continue or heap overflow.
We now extend what we can report with synchronous success, and
synchronous failure with an errno.
See Note [Encoding of result of I/O manager operations]
We don't use these two new cases yet, but we will. In particular an
epoll I/O manager needs to be able to report synchronous success or
failure for waitRead#/waitWrite#.
- - - - -
30f074d9 by Duncan Coutts at 2026-09-09T11:07:01+01:00
Switch waitRead/Write# to use new blocking return frames
and update the I/O managers to set the result before resuming the
blocked threads.
This makes it possible for I/O managers to report synchronous exceptions
from the I/O primops, but that will be done in a subsequent commit.
- - - - -
a8786ced by Duncan Coutts at 2026-09-09T11:07:01+01:00
Switch Poll and Select I/O managers to report sync exceptions
rather than using raiseAsync with blockedOnBadFD_closure.
This uses the new mechanism in the blocking frame return code to report
synchronous exceptions.
- - - - -
7a9df79a by Duncan Coutts at 2026-09-09T11:07:01+01:00
Remove now-unused blockedOnBadFD
It was previously thrown by the select and poll I/O managers, but now
they use raisePrimIOException (with an EBADF errno).
- - - - -
6b0424e3 by Duncan Coutts at 2026-09-09T11:07:01+01:00
Improve the docs for delay# waitRead# and waitWrite#
Document that the waitRead/Write# can throw exceptions (this was true
before too), and that all of them are async exception cancellation
points.
- - - - -
cb71872e by Duncan Coutts at 2026-09-09T14:27:59-04:00
Enable printf warnings for trace functions and fix resulting warnings
Most of the existing printf-style functions are annotated with
attributes to enable gcc/clang warnings for the printf format string,
but several trace functions in Trace.h were missing this annotation.
Enable them, and fix the resulting warnings.
- - - - -
ed800f8c by Alan Zimmerman at 2026-09-09T14:28:00-04:00
EPA: Exact print ConDeclGADT without custom enterAnn
!16321 brought in explicit capture of parens in a ConDeclGADT.
The ExactPrint update introduced a modification of the fundamental
function in exact printing, `enterAnn`, by splitting it into a version
allowing injection of functionality normally handled by the
ExactPrint class methods.
This commit refactors that code, to restore the prior `enterAnn`
version, by following the convention in ExactPrint of introducing a
helper data structure with its own `ExactPrint` instance to achieve
the same effect.
- - - - -
36 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- libraries/ghc-internal/include/RtsIfaceSymbols.h
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
- rts/Capability.c
- rts/HeapStackCheck.cmm
- rts/IOManager.c
- rts/IOManager.h
- rts/IOManagerInternals.h
- rts/Messages.c
- rts/Prelude.h
- rts/PrimOps.cmm
- rts/Printer.c
- rts/STM.c
- rts/Schedule.c
- rts/Sparks.c
- rts/StableName.c
- rts/ThreadPaused.c
- rts/Threads.c
- rts/Trace.h
- rts/include/rts/RtsToHsIface.h
- rts/include/stg/MiscClosures.h
- rts/posix/Poll.c
- rts/posix/Poll.h
- rts/posix/Select.c
- rts/posix/Timeout.c
- rts/sm/Compact.c
- rts/sm/GC.c
- rts/sm/GCUtils.c
- rts/sm/MBlock.c
- rts/sm/NonMoving.c
- rts/sm/NonMovingMark.c
- rts/sm/Storage.c
- rts/sm/Sweep.c
- utils/check-exact/ExactPrint.hs
- utils/deriveConstants/Main.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04fcdddb034e2a24ecaa676a3f391a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04fcdddb034e2a24ecaa676a3f391a…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/jeltsch/ghc-9-14-building-base] 21 commits: rts: fix ctoi_tuple_spill_words getting out of sync
by Wolfgang Jeltsch (＠jeltsch) 09 Sep '26
by Wolfgang Jeltsch (＠jeltsch) 09 Sep '26
09 Sep '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/ghc-9-14-building-base at Glasgow Haskell Compiler / GHC
Commits:
192be0b6 by Luite Stegeman at 2026-09-07T19:43:36-04:00
rts: fix ctoi_tuple_spill_words getting out of sync
Fix a few places that were not updating ctoi_tuple_spill_words
correctly, leading to corruption/crashes when dealing with large
unboxed tuples in bytecode:
- captureContinuationAndAbort
- findRetryFrameHelper/findAtomicallyFrameHelper
- interpretBCO bci_BRK_FUN
fixes #27633
- - - - -
604eb43c by Simon Jakobi at 2026-09-07T19:44:15-04:00
Hadrian: don't capture the testsuite driver's output (#27780)
a6061455d54 switched the Testsuite RunTest case from Shake's cmd to the
cmd' wrapper. cmd' always captures stdout and stderr, and since the
caller asks for Exit, it returns without dumping what it captured. As a
result the testsuite output no longer appears in CI job logs: failures,
performance metrics and the summary were lost with the job.
Use cmdExe, the uncaptured cmd, as the other plain-cmd sites in that
commit do.
Fixes #27780.
Assisted-by: Claude Fable 5.1
- - - - -
06eee015 by Luite Stegeman at 2026-09-08T06:03:06+02:00
rts: Fix missing memory barrier in eval_thunk_selector (#27477)
unchain_thunk_selectors() was missing an ACQUIRE_LOAD for the
indirectee, leading to segfaults and corruption during GC on
weakly-ordered architectures.
Fixes #27477
- - - - -
f8b2bd8f by Alan Zimmerman at 2026-09-08T09:39:12-04:00
EPA Fix HsCmdDo exact print with comments
Exact printing of HsCmdDo was ignoring the location for the do
statements, and this is an annotation that can have comments in it.
Update it so we print the statements as a unit, including any
comments.
Also add the result of auditing that we capture comments in all needed
places, noting that the remaining Anno SrcSpan instances are benign.
- - - - -
1ca7779f by Wolfgang Jeltsch at 2026-09-09T18:36:39+03:00
Add test for `base` being buildable with released GHCs
- - - - -
513398d2 by Wolfgang Jeltsch at 2026-09-09T18:36:39+03:00
Switch to GHC 9.14.2
- - - - -
2725c438 by Wolfgang Jeltsch at 2026-09-09T18:36:39+03:00
Make .gitlab/base-ci.sh` executable
- - - - -
9dd666d9 by Wolfgang Jeltsch at 2026-09-09T18:36:39+03:00
Change the GHC version number back to 9.14.1
- - - - -
451374da by Wolfgang Jeltsch at 2026-09-09T18:36:39+03:00
Enable error propagation in `.gitlab/base-ci.sh`
- - - - -
c8706244 by Wolfgang Jeltsch at 2026-09-09T18:36:39+03:00
Remove the accidental restriction to exactly one GHC
- - - - -
50d76e7a by Wolfgang Jeltsch at 2026-09-09T18:36:39+03:00
Make relative directories absolute
- - - - -
5304a399 by Wolfgang Jeltsch at 2026-09-09T18:36:39+03:00
Make `${project_root}` available to all code
- - - - -
9bf0096c by Wolfgang Jeltsch at 2026-09-09T18:36:39+03:00
Add missing newline escaping
- - - - -
a105b512 by Wolfgang Jeltsch at 2026-09-09T18:36:39+03:00
Fix the GHC installation path
- - - - -
800eefcc by Wolfgang Jeltsch at 2026-09-09T18:36:39+03:00
Move the definition of `withEmptyCallStack` into `base`
- - - - -
89e3c08e by Wolfgang Jeltsch at 2026-09-09T18:36:39+03:00
Change tag `x86_64-windows` to `new-x86_64-windows`
- - - - -
685b19d6 by Wolfgang Jeltsch at 2026-09-09T18:36:39+03:00
Change the actual installation procedure for Windows
- - - - -
3b6990fe by Wolfgang Jeltsch at 2026-09-09T18:36:39+03:00
Switch to using a `Setup.hs` file
- - - - -
ee663f66 by Wolfgang Jeltsch at 2026-09-09T18:36:39+03:00
Add conditional import of `GHC.Essentials`
- - - - -
595c5829 by Wolfgang Jeltsch at 2026-09-09T18:36:39+03:00
Make the use of `-frebindable-known-names` conditional
- - - - -
bdcd39aa by Wolfgang Jeltsch at 2026-09-09T18:36:39+03:00
Disable the inclusion of `GHC.Essentials` for older GHCs
- - - - -
28 changed files:
- .gitlab-ci.yml
- + .gitlab/base-ci.sh
- + changelog.d/fix-parallel-gc-selector-race-27477
- compiler/GHC/Hs/Doc.hs
- compiler/GHC/Hs/Extension/Pass.hs
- hadrian/src/Builder.hs
- libraries/base/base.cabal.in
- libraries/base/src/GHC/Stack.hs
- libraries/ghc-internal/src/GHC/Internal/Stack.hs
- rts/Continuation.c
- rts/Interpreter.c
- rts/Schedule.c
- rts/sm/Evac.c
- + testsuite/tests/bytecode/T27633/Obj.hs
- + testsuite/tests/bytecode/T27633/T27633a.hs
- + testsuite/tests/bytecode/T27633/T27633a.stdout
- + testsuite/tests/bytecode/T27633/T27633b.hs
- + testsuite/tests/bytecode/T27633/T27633b.stdout
- + testsuite/tests/bytecode/T27633/all.T
- + testsuite/tests/ghci.debugger/scripts/T27633c.hs
- + testsuite/tests/ghci.debugger/scripts/T27633c.script
- + testsuite/tests/ghci.debugger/scripts/T27633c.stdout
- + testsuite/tests/ghci.debugger/scripts/T27633c_obj.hs
- testsuite/tests/ghci.debugger/scripts/all.T
- + testsuite/tests/rts/T27477.hs
- + testsuite/tests/rts/T27477.stdout
- testsuite/tests/rts/all.T
- utils/check-exact/ExactPrint.hs
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -69,7 +69,7 @@ stages:
- quick-build # A very quick smoke-test to weed out broken commits
- full-build # Build all the things
- packaging # Source distribution, etc.
- - testing # head.hackage correctness and compiler performance testing
+ - testing # Various tests
- deploy # push documentation
# Note [The CI Story]
@@ -1162,6 +1162,44 @@ ghc-wasm-meta-unreg:
UPSTREAM_GHC_FLAVOUR: unreg
UPSTREAM_GHC_JOB_NAME: x86_64-linux-alpine3_23-wasm-unreg-cross_wasm32-wasi-release+host_fully_static+text_simdutf
+############################################################
+# Testing the compatibility of `base` with other GHCs
+############################################################
+
+base-with-other-ghcs-linux:
+ stage: testing
+ needs:
+ - job: x86_64-linux-deb13-validate
+ optional: true
+ - job: nightly-x86_64-linux-deb13-validate
+ optional: true
+ - job: release-x86_64-linux-deb13-release
+ optional: true
+ dependencies: null
+ image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb12:$DOCKER_REV"
+ tags:
+ - x86_64-linux
+ script: .gitlab/base-ci.sh x86_64-deb12-linux 9.14.1
+ rules:
+ - *full-ci
+
+base-with-other-ghcs-windows:
+ stage: testing
+ needs:
+ - job: x86_64-windows-validate
+ optional: true
+ - job: nightly-x86_64-windows-validate
+ optional: true
+ - job: release-x86_64-windows-release
+ optional: true
+ dependencies: null
+ image: null
+ tags:
+ - new-x86_64-windows
+ script: bash .gitlab/base-ci.sh x86_64-unknown-mingw32 9.14.1
+ rules:
+ - *full-ci
+
############################################################
# Documentation deployment via GitLab Pages
############################################################
=====================================
.gitlab/base-ci.sh
=====================================
@@ -0,0 +1,75 @@
+#!/usr/bin/env bash
+
+# This script supports testing the compatibility of the in-tree `base` with
+# different non-in-tree GHCs. We deliberately use a script separate from
+# `.gitlab/ci.sh` for this purspose, because such support is supposed to become
+# part of the CI infrastructure of a separately maintained `base`.
+#
+# Currently, this script can only test that the in-tree `base` can be *built*
+# with certain *released* GHCs.
+#
+# This script can run on both Unix and Windows. Since GHC’s infrastructure does
+# not offer Cabal pre-installed on Windows, this script uses a `Setup.hs` file
+# to build `base`, which works across operating systems.
+
+# Establish error propagation
+set -e -o pipefail
+
+# Process arguments
+if [ $# -lt 1 ]
+then
+ echo 'Build `base` with released GHCs'
+ echo "Usage: base-ci ⟨platform⟩ ⟨ghc-version⟩ …"
+ exit 1
+fi >&2
+platform=$1
+shift
+ghc_versions=$*
+
+# Save project root
+project_root=$PWD
+
+# Create directories for other GHCs
+mkdir other-ghcs
+mkdir other-ghcs/src
+mkdir other-ghcs/opt
+
+# Amend the `base` sources
+cd libraries/base
+sed -E -e 's/^( *ghc-internal)[^[:alnum:]-].*(,|$)/\1\2/' \
+ < base.cabal.in \
+ > base.cabal
+cat <<. >Setup.hs
+import Distribution.Simple
+main = defaultMain
+.
+cd ${project_root}
+
+# Build `base` with the different GHCs
+for ghc_version in ${ghc_versions}
+do
+ # Install the GHC
+ ghc_installation=${project_root}/other-ghcs/opt/${ghc_version}
+ cd other-ghcs/src
+ archive_file=ghc-${ghc_version}-${platform}.tar.xz
+ curl https://downloads.haskell.org/~ghc/${ghc_version}/${archive_file} \
+ >${ghc_version}.tar.xz
+ tar -xJf ${ghc_version}.tar.xz
+ if [ -f ghc-${ghc_version}-*/configure ]
+ then # Unix
+ cd ghc-${ghc_version}-*
+ ./configure --prefix "${ghc_installation}"
+ make install
+ else # Windows
+ mv ghc-${ghc_version}-* "${ghc_installation}"
+ fi
+ cd ${project_root}
+
+ # Build `base` with the installed GHC
+ cd libraries/base
+ "${ghc_installation}/bin/runghc" Setup.hs configure \
+ --with-compiler "${ghc_installation}/bin/ghc" \
+ -O0
+ "${ghc_installation}/bin/runghc" Setup.hs build
+ cd ${project_root}
+done
=====================================
changelog.d/fix-parallel-gc-selector-race-27477
=====================================
@@ -0,0 +1,10 @@
+section: rts
+synopsis: Fix a parallel GC race on weakly-ordered architectures (AArch64) that could crash or silently corrupt the heap
+description:
+ On weakly-ordered architectures such as AArch64 programs using
+ could crash during parallel garbage collection (segmentation fault
+ or ``internal error: eval_thunk_selector: strange selectee <n>``) or
+ continue running with silently corrupted heap data, due to a missing
+ memory barrier in the parallel GC.
+mrs: !16488
+issues: #27477
=====================================
compiler/GHC/Hs/Doc.hs
=====================================
@@ -58,6 +58,7 @@ import Language.Haskell.Syntax.Doc
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Module.Name
+-- Exact print annotations ignore LHsDoc, so bare SrcSpan is fine
type instance Anno (WithHsDocIdentifiers (HsDocString (GhcPass pass)) (GhcPass pass)) = SrcSpan
deriving instance (Data pass, Data (LIdP pass), Data a) => Data (WithHsDocIdentifiers a pass)
=====================================
compiler/GHC/Hs/Extension/Pass.hs
=====================================
@@ -46,6 +46,7 @@ type instance XRec (GhcPass p) a = XRecGhc a
-- but pass-independent, source location
type XRecGhc a = GenLocated (Anno a) a
+-- Exact print annotations ignore LHsDoc, so bare SrcSpan is fine
type instance Anno (HsDocString (GhcPass _)) = SrcSpan
type instance Anno HsDocStringChunk = SrcSpan
=====================================
hadrian/src/Builder.hs
=====================================
@@ -387,7 +387,7 @@ instance H.Builder Builder where
-- RunTest produces a very large amount of (colorised) output;
-- Don't attempt to capture it.
Testsuite RunTest -> do
- Exit code <- cmd' prog buildArgs buildOptions
+ Exit code <- cmdExe prog buildArgs buildOptions
when (code /= ExitSuccess) $ do
fail "tests failed"
=====================================
libraries/base/base.cabal.in
=====================================
@@ -33,9 +33,10 @@ Library
ghc-internal == @ProjectVersionForLib@.*,
ghc-prim,
- -- Set -frebindable-known-names,
- -- since GHC.Essentials isn't available yet
- ghc-options: -frebindable-known-names
+ if impl(ghc >= 10.1)
+ -- Set -frebindable-known-names,
+ -- since GHC.Essentials isn't available yet
+ ghc-options: -frebindable-known-names
exposed-modules:
Control.Applicative
@@ -307,9 +308,11 @@ Library
other-modules:
Data.List.NubOrdSet
- GHC.Essentials
System.CPUTime.Unsupported
System.CPUTime.Utils
+ if impl(ghc >= 10.1)
+ other-modules:
+ GHC.Essentials
if os(windows)
other-modules:
System.CPUTime.Windows
=====================================
libraries/base/src/GHC/Stack.hs
=====================================
@@ -1,5 +1,9 @@
{-# LANGUAGE Safe #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ImplicitParams #-}
+
-- |
--
-- Module : GHC.Stack
@@ -51,3 +55,26 @@ module GHC.Stack
) where
import GHC.Internal.Stack
+
+#if __GLASGOW_HASKELL__ > 1000
+
+import GHC.Essentials as Rebindable
+
+#endif
+
+-- | Explicitly bring the empty call stack into scope.
+--
+-- Mostly useful for silencing warnings generated by @-Wdefaulted-callstack@ in
+-- places such as:
+--
+-- - The body of a class method in an instance of an externally defined type
+-- class whose type signature doesn't contain a 'HasCallStack' constraint.
+--
+-- - The body of the @main@ function.
+--
+-- @since 4.24.0.0
+withEmptyCallStack :: (HasCallStack => a) -> a
+withEmptyCallStack do_this =
+ -- See Note [Warn about defaulted CallStacks]
+ let ?callStack = emptyCallStack
+ in do_this
=====================================
libraries/ghc-internal/src/GHC/Internal/Stack.hs
=====================================
@@ -29,7 +29,7 @@ module GHC.Internal.Stack (
-- * HasCallStack call stacks
CallStack, HasCallStack, callStack, emptyCallStack, freezeCallStack,
fromCallSiteList, getCallStack, popCallStack,
- pushCallStack, withFrozenCallStack, withEmptyCallStack,
+ pushCallStack, withFrozenCallStack,
prettyCallStackLines, prettyCallStack,
-- * Source locations
@@ -105,23 +105,6 @@ withFrozenCallStack do_this =
let ?callStack = freezeCallStack (popCallStack callStack)
in do_this
--- | Explicitly bring the empty call stack into scope.
---
--- Mostly useful for silencing warnings generated by @-Wdefaulted-callstack@ in
--- places such as:
---
--- - The body of a class method in an instance of an externally defined type
--- class whose type signature doesn't contain a 'HasCallStack' constraint.
---
--- - The body of the @main@ function.
---
--- @since 4.24.0.0
-withEmptyCallStack :: (HasCallStack => a) -> a
-withEmptyCallStack do_this =
- -- See Note [Warn about defaulted CallStacks]
- let ?callStack = emptyCallStack
- in do_this
-
-- prettySrcLoc and prettyCallStack are defined here to avoid hs-boot
-- files. See Note [Definition of CallStack]
=====================================
rts/Continuation.c
=====================================
@@ -392,6 +392,10 @@ StgClosure *captureContinuationAndAbort(Capability *cap, StgTSO *tso, StgPromptT
const StgInfoTable *apply_mask_frame = NULL;
StgWord mask_frame_offset = 0;
+ // see Note [GHCi unboxed tuples stack spills]
+ bool seen_ctoi_tuple_frame = false;
+ StgWord ctoi_tuple_spill_words = 0;
+
/* --- Phase 1: Find the matching prompt frame ---------------------------- */
IF_DEBUG(continuation,
@@ -459,7 +463,8 @@ StgClosure *captureContinuationAndAbort(Capability *cap, StgTSO *tso, StgPromptT
// see Note [GHCi unboxed tuples stack spills]
if (info_ptr == &stg_ctoi_t_info) {
- tso->ctoi_tuple_spill_words = frame[CTOI_OLD_TUPLE_SPILL_WORDS_OFFSET];
+ seen_ctoi_tuple_frame = true;
+ ctoi_tuple_spill_words = frame[CTOI_OLD_TUPLE_SPILL_WORDS_OFFSET];
}
// Advance to the next frame.
@@ -475,6 +480,11 @@ StgClosure *captureContinuationAndAbort(Capability *cap, StgTSO *tso, StgPromptT
dirty_TSO(cap, tso);
dirty_STACK(cap, stack);
+ // see Note [GHCi unboxed tuples stack spills] in StgMiscClosures.cmm
+ if (seen_ctoi_tuple_frame) {
+ tso->ctoi_tuple_spill_words = ctoi_tuple_spill_words;
+ }
+
StgContinuation *cont = (StgContinuation *)allocate(cap, CONTINUATION_sizeW(total_words));
SET_HDR(cont, &stg_CONTINUATION_info, stack->header.prof.ccs);
cont->apply_mask_frame = apply_mask_frame;
=====================================
rts/Interpreter.c
=====================================
@@ -1982,6 +1982,20 @@ run_BCO:
for (i = 0; i < size_words; i++) {
new_aps->payload[i] = (StgClosure *)ReadSpW(i);
}
+
+ /* The stg_ctoi_t frame we copied is entered again when
+ execution resumes, but tso->ctoi_tuple_spill_words
+ holds the enclosing frame's count: it was restored
+ from old_spill when this case continuation was entered
+ (bci_RETURN_T). Put back the count belonging to this
+ frame, so the invariant holds while the thread sits at
+ the breakpoint.
+
+ See Note [GHCi unboxed tuples stack spills] */
+ if (ReadSpW(size_returned_frame) == (W_)&stg_ctoi_t_info) {
+ cap->r.rCurrentTSO->ctoi_tuple_spill_words =
+ ReadSpW(size_returned_frame + CTOI_TUPLE_INFO_OFFSET) >> 24;
+ }
}
else {
=====================================
rts/Schedule.c
=====================================
@@ -3271,6 +3271,10 @@ findRetryFrameHelper (Capability *cap, StgTSO *tso)
default:
ASSERT(info->i.type != CATCH_FRAME);
ASSERT(info->i.type != STOP_FRAME);
+ // see Note [GHCi unboxed tuples stack spills] in StgMiscClosures.cmm
+ if (*p == (StgWord)&stg_ctoi_t_info) {
+ tso->ctoi_tuple_spill_words = p[CTOI_OLD_TUPLE_SPILL_WORDS_OFFSET]; // restore old_spill
+ }
p = next;
continue;
}
@@ -3332,6 +3336,10 @@ findAtomicallyFrameHelper (Capability *cap, StgTSO *tso)
default:
ASSERT(info->i.type != CATCH_FRAME);
ASSERT(info->i.type != STOP_FRAME);
+ // see Note [GHCi unboxed tuples stack spills] in StgMiscClosures.cmm
+ if (*p == (StgWord)&stg_ctoi_t_info) {
+ tso->ctoi_tuple_spill_words = p[CTOI_OLD_TUPLE_SPILL_WORDS_OFFSET]; // restore old_spill
+ }
p = next;
continue;
}
=====================================
rts/sm/Evac.c
=====================================
@@ -1361,7 +1361,11 @@ selector_loop:
// from-space during marking, for example. We rely on the property
// that evacuate() doesn't mind if it gets passed a to-space pointer.
- info = RELAXED_LOAD((StgInfoTable**) &selectee->header.info);
+ // NB. this load must be ordered: the selectee may be updated
+ // concurrently by another GC thread's unchain_thunk_selectors(),
+ // which publishes an indirection by writing the indirectee and
+ // then RELEASE-storing the info pointer. See #27477.
+ info = ACQUIRE_LOAD((StgInfoTable**) &selectee->header.info);
if (IS_FORWARDING_PTR(info)) {
// We don't follow pointers into to-space; the constructor
=====================================
testsuite/tests/bytecode/T27633/Obj.hs
=====================================
@@ -0,0 +1,13 @@
+{-# OPTIONS_GHC -fobject-code #-}
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+module Obj where
+
+import GHC.Exts
+
+-- Compiled to object code; returns a large unboxed tuple, so the return
+-- into an interpreted caller goes through the native stg_ctoi_t entry code,
+-- which reads tso->ctoi_tuple_spill_words.
+-- See Note [GHCi unboxed tuples stack spills] in rts/StgMiscClosures.cmm.
+mkT :: State# RealWorld -> (# State# RealWorld, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int# #)
+mkT s = (# s, 1#, 2#, 3#, 4#, 5#, 6#, 7#, 8#, 9#, 10#, 11#, 12#, 13#, 14#, 15#, 16#, 17#, 18#, 19#, 20#, 21#, 22#, 23#, 24# #)
+{-# NOINLINE mkT #-}
=====================================
testsuite/tests/bytecode/T27633/T27633a.hs
=====================================
@@ -0,0 +1,34 @@
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+{-# OPTIONS_GHC -fbyte-code #-}
+
+-- Regression test for #27633 (bug 1): a failed control0# capture must not
+-- clobber tso->ctoi_tuple_spill_words while a generic stg_ctoi_t frame is
+-- still live on the stack.
+-- See Note [GHCi unboxed tuples stack spills] in rts/StgMiscClosures.cmm.
+
+module Main where
+
+import Control.Exception
+import GHC.Exts
+import GHC.IO (IO(..))
+import Obj
+
+unIO :: IO a -> State# RealWorld -> (# State# RealWorld, a #)
+unIO (IO f) = f
+
+-- control0# with a tag that has no matching prompt anywhere on the stack;
+-- the resulting exception is caught right here, above the stg_ctoi_t frame,
+-- so the unwind stops before reaching the frame.
+failing :: IO ()
+failing = IO (\s0 -> case newPromptTag# s0 of
+ (# s1, tag #) -> control0# tag (\_ s -> (# s, () #)) s1)
+ `catch` \(SomeException _) -> return ()
+
+scrut :: State# RealWorld -> (# State# RealWorld, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int# #)
+scrut s0 = case unIO failing s0 of (# s1, _ #) -> mkT s1
+{-# NOINLINE scrut #-}
+
+main :: IO ()
+main = IO (\s0 -> case scrut s0 of
+ (# s1, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24 #) ->
+ unIO (print (I# (x1 +# x2 +# x3 +# x4 +# x5 +# x6 +# x7 +# x8 +# x9 +# x10 +# x11 +# x12 +# x13 +# x14 +# x15 +# x16 +# x17 +# x18 +# x19 +# x20 +# x21 +# x22 +# x23 +# x24))) s1)
=====================================
testsuite/tests/bytecode/T27633/T27633a.stdout
=====================================
@@ -0,0 +1 @@
+300
=====================================
testsuite/tests/bytecode/T27633/T27633b.hs
=====================================
@@ -0,0 +1,39 @@
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+{-# OPTIONS_GHC -fbyte-code #-}
+
+-- Regression test for #27633 (bug 2): STM retry unwinding
+-- (findRetryFrameHelper/findAtomicallyFrameHelper) must restore
+-- tso->ctoi_tuple_spill_words when it discards a generic stg_ctoi_t frame.
+-- See Note [GHCi unboxed tuples stack spills] in rts/StgMiscClosures.cmm.
+
+module Main where
+
+import GHC.Conc (STM(..), atomically, orElse)
+import GHC.Exts
+import GHC.IO (IO(..))
+import Obj
+
+unIO :: IO a -> State# RealWorld -> (# State# RealWorld, a #)
+unIO (IO f) = f
+
+-- Inside the transaction: case on a 16-field tuple (different spill count
+-- than the outer 24-field one), then retry. The generic stg_ctoi_t frame
+-- pushed for this case is discarded by findRetryFrameHelper.
+innerScrut :: State# RealWorld -> (# State# RealWorld, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int# #)
+innerScrut s0 = case retry# s0 of (# s1, () #) -> (# s1, 1#, 2#, 3#, 4#, 5#, 6#, 7#, 8#, 9#, 10#, 11#, 12#, 13#, 14#, 15#, 16# #)
+{-# NOINLINE innerScrut #-}
+
+stmBody :: STM ()
+stmBody = STM (\s0 -> case innerScrut s0 of
+ (# s1, b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16 #) -> (# s1, () #))
+
+outerScrut :: State# RealWorld -> (# State# RealWorld, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int# #)
+outerScrut s0 =
+ case unIO (atomically (stmBody `orElse` return ())) s0 of
+ (# s1, _ #) -> mkT s1
+{-# NOINLINE outerScrut #-}
+
+main :: IO ()
+main = IO (\s0 -> case outerScrut s0 of
+ (# s1, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24 #) ->
+ unIO (print (I# (x1 +# x2 +# x3 +# x4 +# x5 +# x6 +# x7 +# x8 +# x9 +# x10 +# x11 +# x12 +# x13 +# x14 +# x15 +# x16 +# x17 +# x18 +# x19 +# x20 +# x21 +# x22 +# x23 +# x24))) s1)
=====================================
testsuite/tests/bytecode/T27633/T27633b.stdout
=====================================
@@ -0,0 +1 @@
+300
=====================================
testsuite/tests/bytecode/T27633/all.T
=====================================
@@ -0,0 +1,21 @@
+test('T27633a',
+ [ extra_files(['Obj.hs']),
+ req_interp,
+ req_bco,
+ only_ways(ghci_ways),
+ extra_ways(ghci_ways),
+ ],
+ compile_and_run,
+ ['']
+ )
+
+test('T27633b',
+ [ extra_files(['Obj.hs']),
+ req_interp,
+ req_bco,
+ only_ways(ghci_ways),
+ extra_ways(ghci_ways),
+ ],
+ compile_and_run,
+ ['']
+ )
=====================================
testsuite/tests/ghci.debugger/scripts/T27633c.hs
=====================================
@@ -0,0 +1,29 @@
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+
+-- Stopping at a breakpoint in the case continuation of a large unboxed
+-- tuple return (generic stg_ctoi_t frame) and resuming must re-enter the
+-- frame with the correct tso->ctoi_tuple_spill_words. The continuation
+-- breakpoint is activated via :stepout.
+-- See Note [GHCi unboxed tuples stack spills] in rts/StgMiscClosures.cmm.
+
+module Main where
+
+import GHC.Exts
+import GHC.IO (IO(..))
+import T27633c_obj
+
+unIO :: IO a -> State# RealWorld -> (# State# RealWorld, a #)
+unIO (IO f) = f
+
+poke :: Int -> IO Int
+poke x =
+ return (x + 1) -- line 20: initial breakpoint
+
+scrut :: State# RealWorld -> (# State# RealWorld, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int# #)
+scrut s0 = case unIO (poke 41) s0 of (# s1, _ #) -> mkT s1
+{-# NOINLINE scrut #-}
+
+main :: IO ()
+main = IO (\s0 -> case scrut s0 of
+ (# s1, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24 #) ->
+ unIO (print (I# (x1 +# x2 +# x3 +# x4 +# x5 +# x6 +# x7 +# x8 +# x9 +# x10 +# x11 +# x12 +# x13 +# x14 +# x15 +# x16 +# x17 +# x18 +# x19 +# x20 +# x21 +# x22 +# x23 +# x24))) s1)
=====================================
testsuite/tests/ghci.debugger/scripts/T27633c.script
=====================================
@@ -0,0 +1,13 @@
+:load T27633c.hs
+-- break inside poke, while the generic stg_ctoi_t frame from main's
+-- 24-field tuple case is live on the stack
+:break 20
+main
+-- step out to the small case continuation in scrut
+:stepout
+-- step out again: activates the breakpoint of main's tuple case
+-- continuation BCO, entered through the generic stg_ctoi_t frame
+:stepout
+-- resuming re-enters the stg_ctoi_t frame; with a stale
+-- tso->ctoi_tuple_spill_words this segfaulted
+:continue
=====================================
testsuite/tests/ghci.debugger/scripts/T27633c.stdout
=====================================
@@ -0,0 +1,9 @@
+Breakpoint 0 activated at T27633c.hs:20:3-16
+Stopped in Main.poke, T27633c.hs:20:3-16
+_result :: IO Int = _
+x :: Int = 41
+Stopped in Main.scrut, T27633c.hs:23:17-33
+_result :: (# State# RealWorld, Int #) = _
+Stopped in Main.main, T27633c.hs:(27,19)-(29,193)
+_result :: (# State# RealWorld, () #) = _
+300
=====================================
testsuite/tests/ghci.debugger/scripts/T27633c_obj.hs
=====================================
@@ -0,0 +1,12 @@
+{-# OPTIONS_GHC -fobject-code #-}
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+module T27633c_obj where
+
+import GHC.Exts
+
+-- Compiled to object code; returns a large unboxed tuple, so the return
+-- into an interpreted caller goes through the native stg_ctoi_t entry code,
+-- which reads tso->ctoi_tuple_spill_words.
+mkT :: State# RealWorld -> (# State# RealWorld, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int# #)
+mkT s = (# s, 1#, 2#, 3#, 4#, 5#, 6#, 7#, 8#, 9#, 10#, 11#, 12#, 13#, 14#, 15#, 16#, 17#, 18#, 19#, 20#, 21#, 22#, 23#, 24# #)
+{-# NOINLINE mkT #-}
=====================================
testsuite/tests/ghci.debugger/scripts/all.T
=====================================
@@ -153,3 +153,5 @@ test('T26042e', extra_files(['T26042e.hs']), ghci_script, ['T26042e.script'])
test('T26042f1', extra_files(['T26042f.hs', 'T26042f.script']), ghci_script, ['T26042f.script']) # >> is not inlined, so stepout has nowhere to stop
test('T26042f2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042f.hs', 'T26042f.script'])], ghci_script, ['T26042f.script'])
test('T26042g', extra_files(['T26042g.hs']), ghci_script, ['T26042g.script'])
+
+test('T27633c', extra_files(['T27633c_obj.hs']), ghci_script, ['T27633c.script'])
=====================================
testsuite/tests/rts/T27477.hs
=====================================
@@ -0,0 +1,169 @@
+{-# LANGUAGE BangPatterns #-}
+
+-- Stress test for #27477: missing ACQUIRE in eval_thunk_selector
+-- (rts/sm/Evac.c).
+--
+-- With the bug present this test crashes or reports value mismatches
+-- within a few seconds on AArch64; on strongly-ordered targets
+-- it just passes.
+
+module Main (main) where
+
+import Control.Concurrent
+import Control.Exception
+import Control.Monad
+import Data.IORef
+import System.Environment
+import System.Exit
+import System.IO
+import System.Mem (performMinorGC)
+
+data T = T { nxt :: T, val :: !Int }
+
+-- expected values and the cells that should evaluate to them
+type Batch = ([Int], [T])
+
+tailD, branchD, branchesPerCell :: Int
+tailD = 12 -- shared tail length per cluster
+branchD = 3 -- private branch length
+branchesPerCell = 2
+-- tailD + branchD must stay below MAX_THUNK_SELECTOR_DEPTH (16)
+
+{-# NOINLINE spineEnd #-}
+spineEnd :: T
+spineEnd = errorWithoutStackTrace "spine end reached"
+
+-- Fully evaluated spine of constructors; cell i from the head has val i+1.
+buildSpine :: Int -> IO T
+buildSpine len = evaluate (go len (T spineEnd 0))
+ where
+ go :: Int -> T -> T
+ go 0 acc = acc
+ go k acc = go (k - 1) (T acc k)
+
+-- k selector thunks, shallow-first: cell i selects from cell i-1,
+-- cell 0 selects from t. If t evaluates to spine cell m (val m+1),
+-- cell i evaluates to spine cell m+1+i (val m+2+i).
+{-# NOINLINE selChain #-}
+selChain :: Int -> T -> [T]
+selChain 0 _ = []
+selChain k t = let t' = nxt t in t' : selChain (k - 1) t'
+
+lenL :: [a] -> Int
+lenL = go 0
+ where
+ go !n [] = n
+ go !n (_ : xs) = go (n + 1) xs
+
+everyN :: Int -> [a] -> [a]
+everyN _ [] = []
+everyN n (x : xs) = x : everyN n (drop (n - 1) xs)
+
+-- One branch hanging off tail cell tj (which evaluates to val jval):
+-- branch cell i evaluates to jval+1+i. Returned deepest-first.
+{-# NOINLINE mkBranch #-}
+mkBranch :: Int -> T -> IO Batch
+mkBranch jval tj = do
+ let cells = selChain branchD tj
+ _ <- evaluate (lenL cells)
+ let expected = [ jval + 1 + i | i <- [0 .. branchD - 1] ]
+ pure (reverse expected, reverse cells)
+
+-- A cluster: one private spine, one shared tail of selectors over it,
+-- branchesPerCell branches of selectors converging on every tail cell.
+-- Neither the spine nor the tail is returned: they must stay reachable
+-- only through the branch selectors.
+buildCluster :: IO [Batch]
+buildCluster = do
+ sp <- buildSpine (tailD + branchD + 4)
+ let tails = selChain tailD sp
+ _ <- evaluate (lenL tails)
+ bss <- forM (zip [0 ..] tails) $ \(j, tj) ->
+ replicateM branchesPerCell (mkBranch (j + 2) tj)
+ pure (concat bss)
+
+verifyBatch :: IORef Int -> Int -> Batch -> IO ()
+verifyBatch errs wid (es0, ts0) = go es0 ts0
+ where
+ go (e : es) (t : ts) = do
+ v <- evaluate (val t)
+ when (v /= e) $ do
+ hPutStrLn stderr $
+ "MISMATCH worker=" ++ show wid
+ ++ " expected=" ++ show e ++ " got=" ++ show v
+ modifyIORef' errs (+ 1)
+ go es ts
+ go _ _ = pure ()
+
+-- simple cyclic barrier
+newtype Barrier = Barrier (MVar (Int, [MVar ()]))
+
+newBarrier :: IO Barrier
+newBarrier = Barrier <$> newMVar (0, [])
+
+awaitBarrier :: Barrier -> Int -> IO ()
+awaitBarrier (Barrier st) total = do
+ w <- newEmptyMVar
+ join $ modifyMVar st $ \(k, ws) ->
+ if k + 1 == total
+ then pure ((0, []), mapM_ (\m -> putMVar m ()) ws)
+ else pure ((k + 1, w : ws), takeMVar w)
+
+worker :: Int -> Int -> Int -> Barrier -> [IORef [Batch]] -> IORef Int -> Int -> IO ()
+worker rounds clusters nWorkers bar slots errs wid =
+ forM_ [1 .. rounds] $ \(_r :: Int) -> do
+ -- build fresh selector clusters, publish them
+ batches <- concat <$> replicateM clusters buildCluster
+ writeIORef (slots !! wid) batches
+ awaitBarrier bar nWorkers
+ -- root each branch's deepest cell via fresh cons cells in our own
+ -- nursery (so our GC thread evacuates the shared cells itself), in
+ -- a per-worker interleaved order so that different GC threads
+ -- sweep different branches of the same shared tails concurrently
+ published <- mapM readIORef slots
+ let allBatches = concat published
+ ordered
+ | nWorkers > 1 =
+ concat [ everyN nWorkers (drop ((wid + k) `mod` nWorkers) allBatches)
+ | k <- [0 .. nWorkers - 1] ]
+ | otherwise = allBatches
+ deepTs = [ t | (_, t : _) <- ordered ]
+ deepEs = [ e | (e : _, _) <- ordered ]
+ _ <- evaluate (lenL deepTs)
+ _ <- evaluate (lenL deepEs)
+ awaitBarrier bar nWorkers
+ -- run a parallel GC with everything live
+ when (wid == 0) performMinorGC
+ awaitBarrier bar nWorkers
+ -- force everything and check the values
+ verifyBatch errs wid (deepEs, deepTs)
+ awaitBarrier bar nWorkers
+
+main :: IO ()
+main = do
+ hSetBuffering stderr LineBuffering
+ args <- getArgs
+ let atDef d i = if length args > i then read (args !! i) else d
+ rounds = atDef 600 0
+ clusters = atDef 48 1
+ n <- getNumCapabilities
+ bar <- newBarrier
+ slots <- replicateM n (newIORef [])
+ errs <- newIORef 0
+ dones <- forM [0 .. n - 1] $ \i -> do
+ done <- newEmptyMVar
+ _ <- forkOn i $
+ (worker rounds clusters n bar slots errs i >> putMVar done Nothing)
+ `catch` \e -> putMVar done (Just (e :: SomeException))
+ pure done
+ results <- mapM takeMVar dones
+ forM_ results $ \r -> case r of
+ Just e -> do
+ hPutStrLn stderr ("worker exception: " ++ show e)
+ exitWith (ExitFailure 2)
+ Nothing -> pure ()
+ ec <- readIORef errs
+ when (ec > 0) $ do
+ hPutStrLn stderr ("FAILED: " ++ show ec ++ " mismatches")
+ exitWith (ExitFailure 2)
+ putStrLn "OK"
=====================================
testsuite/tests/rts/T27477.stdout
=====================================
@@ -0,0 +1 @@
+OK
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -720,3 +720,12 @@ test('T27585',
, extra_run_opts('+RTS -i0 -RTS')
],
compile_and_run, ['-O -rtsopts'])
+
+test('T27477',
+ [ extra_run_opts('600 24 +RTS -N4 -A1m -RTS')
+ , req_ghc_smp
+ , req_target_smp
+ , only_ways(['threaded1', 'threaded2'])
+ ],
+ compile_and_run, ['-O2'])
+
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -3404,13 +3404,13 @@ instance ExactPrint (HsCmd GhcPs) where
e' <- markAnnotated e
return (HsCmdLet (tkLet', tkIn') binds' e')
- exact (HsCmdDo (an0,loc) (L l es)) = do
+ exact (HsCmdDo (an0,loc) es) = do
debugM $ "HsCmdDo"
loc' <- printStringAtAA loc "do"
(an1,es') <- markAnnList' an0 $ do
- ee <- mapM markAnnotated es
+ ee <- markAnnotated es
return ee
- return (HsCmdDo (an1,loc') (L l es'))
+ return (HsCmdDo (an1,loc') es')
-- ---------------------------------------------------------------------
@@ -4508,10 +4508,10 @@ instance ExactPrint [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))] whe
Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do
debugM $ "LocatedL [ExprLStmt: snocView"
ls' <- markAnnotated ls
- initStmts' <- markAnnotated initStmts
+ initStmts' <- mapM markAnnotated initStmts
return (initStmts' ++ [ls'])
_ -> do
- stmts' <- markAnnotated stmts
+ stmts' <- mapM markAnnotated stmts
return stmts'
instance ExactPrint [Located HsDocStringChunk] where
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3fb46764503ae051f152940410a0d1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3fb46764503ae051f152940410a0d1…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/mangoiv/9.12.5-rc4] 5 commits: base: Don't drop exception context in SomeException(toException)
by Magnus (＠MangoIV) 09 Sep '26
by Magnus (＠MangoIV) 09 Sep '26
09 Sep '26
Magnus pushed to branch wip/mangoiv/9.12.5-rc4 at Glasgow Haskell Compiler / GHC
Commits:
1e956205 by Ben Gamari at 2026-09-09T15:01:09+02:00
base: Don't drop exception context in SomeException(toException)
For reasons that are lost to time, the implementation of [CLC #200]
that was merged inappropriately dropped `ExceptionContext` in the
`toException` implementation given to `SomeException`.
Fix this infelicity.
[CLC #200]: https://github.com/haskell/core-libraries-committee/issues/200
(cherry picked from commit 2ab02c579a9625438f5281a258051cb32ba40004)
- - - - -
1ad61a58 by Zubin Duggal at 2026-09-09T15:01:09+02:00
DmdAnal: Fix maxDmdType
We need to eta expand the smaller DmdType using defaultArgDmd, like in lubDmdType.
Introduce zipDmdType as a common combinator to implement both maxDmdType and lubDmdType
uniformly.
fixes #27626
(cherry picked from commit e31885816b7c597ad89b05da64b21c5a241bf674)
- - - - -
1ee1b27b by Zubin Duggal at 2026-09-09T15:01:09+02:00
hadrian: Fix links to remaining doc sites to not use the package hash for haddock links
In 07267f79d91169f474cacc8bcd38d76a6e97887d we changed hadrian to not include the package hash in the haddock
directory. This patch takes care of a few remaining links that were missed in that patch
Fixes #27671
(cherry picked from commit 1446bb039a635f2b836be19f062cbffa568fe4c5)
- - - - -
4dcd9f77 by Luite Stegeman at 2026-09-09T15:01:09+02:00
rts: Fix missing memory barrier in eval_thunk_selector (#27477)
unchain_thunk_selectors() was missing an ACQUIRE_LOAD for the
indirectee, leading to segfaults and corruption during GC on
weakly-ordered architectures.
Fixes #27477
(cherry picked from commit 06eee015be4e361fe9cb33e8a608ab2ea1386b52)
- - - - -
e7192511 by mangoiv at 2026-09-09T15:01:09+02:00
testsuite: allow metric decrease in WWRec
Metric Decrease:
WWRec
- - - - -
20 changed files:
- + changelog.d/27626
- + changelog.d/T27455
- + changelog.d/fix-parallel-gc-selector-race-27477
- compiler/GHC/Types/Demand.hs
- docs/index.html.in
- docs/users_guide/ghc_config.py.in
- hadrian/src/Rules/Generate.hs
- libraries/base/changelog.md
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
- rts/sm/Evac.c
- + testsuite/tests/dmdanal/should_run/M2.hs
- + testsuite/tests/dmdanal/should_run/T27626.hs
- + testsuite/tests/dmdanal/should_run/T27626.stdout
- testsuite/tests/dmdanal/should_run/all.T
- testsuite/tests/ghc-e/should_fail/T18441fail7.stderr
- testsuite/tests/ghc-e/should_fail/T9930fail.stderr
- testsuite/tests/ghc-e/should_run/ghc-e005.stderr
- + testsuite/tests/rts/T27477.hs
- + testsuite/tests/rts/T27477.stdout
- testsuite/tests/rts/all.T
Changes:
=====================================
changelog.d/27626
=====================================
@@ -0,0 +1,5 @@
+section: compiler
+synopsis: Fix a bug where an argument used only by a function's stable unfolding
+ could still be marked absent, resulting in a runtime crash.
+mrs: !16503
+issues: #27626
=====================================
changelog.d/T27455
=====================================
@@ -0,0 +1,8 @@
+section: base
+issues: #27455
+mrs: !16274
+synopsis:
+ Don't drop `ExceptionContext` in `SomeException(toException)`
+description:
+ Previously the implementation of ``Exception(toException)`` given to `SomeException` would inappropriately drop the carried `ExceptionContext`. Now ``toException = id``, faithfully implementing the semantics proposed in :ref:`CLC Proposal #200 <https://github.com/haskell/core-libraries-committee/issues/200>`.
+
=====================================
changelog.d/fix-parallel-gc-selector-race-27477
=====================================
@@ -0,0 +1,10 @@
+section: rts
+synopsis: Fix a parallel GC race on weakly-ordered architectures (AArch64) that could crash or silently corrupt the heap
+description:
+ On weakly-ordered architectures such as AArch64 programs using
+ could crash during parallel garbage collection (segmentation fault
+ or ``internal error: eval_thunk_selector: strange selectee <n>``) or
+ continue running with silently corrupted heap data, due to a missing
+ memory barrier in the parallel GC.
+mrs: !16488
+issues: #27477
=====================================
compiler/GHC/Types/Demand.hs
=====================================
@@ -1855,12 +1855,14 @@ botDmdEnv = mkEmptyDmdEnv botDiv
exnDmdEnv :: DmdEnv
exnDmdEnv = mkEmptyDmdEnv exnDiv
+combineDmdEnv :: (Demand -> Demand -> Demand) -> DmdEnv -> DmdEnv -> DmdEnv
+combineDmdEnv f (DE fv1 d1) (DE fv2 d2)
+ -- See Note [Demand env Equality]
+ = DE (plusVarEnv_CD f fv1 (defaultFvDmd d1) fv2 (defaultFvDmd d2))
+ (lubDivergence d1 d2)
+
lubDmdEnv :: DmdEnv -> DmdEnv -> DmdEnv
-lubDmdEnv (DE fv1 d1) (DE fv2 d2) = DE lub_fv lub_div
- where
- -- See Note [Demand env Equality]
- lub_fv = plusVarEnv_CD lubDmd fv1 (defaultFvDmd d1) fv2 (defaultFvDmd d2)
- lub_div = lubDivergence d1 d2
+lubDmdEnv = combineDmdEnv lubDmd
addVarDmdEnv :: DmdEnv -> Id -> Demand -> DmdEnv
addVarDmdEnv env@(DE fvs div) id dmd
@@ -1915,36 +1917,31 @@ instance Eq DmdType where
= ds1 == ds2 -- cheap checks first
&& env1 == env2
+-- | The smaller 'DmdType' is eta expanded using its 'defaultArgDmd'.
+-- See Note [Default demand on free variables and arguments].
+zipDmdType :: (Demand -> Demand -> Demand) -> DmdType -> DmdType -> DmdType
+zipDmdType f (DmdType fv1 ds1) (DmdType fv2 ds2)
+ = DmdType (combineDmdEnv f fv1 fv2) (go ds1 ds2)
+ where
+ def1, def2 :: Demand -- Default argument demands for eta expansion
+ def1 = defaultArgDmd (de_div fv1)
+ def2 = defaultArgDmd (de_div fv2)
+
+ -- If `ds1` is shorter than `ds2`, extend `ds1` with the appropriate
+ -- default demand `def1`; and similarly if `ds2` is shorter
+ go (d1:ds1') (d2:ds2') = f d1 d2 : go ds1' ds2'
+ go [] ds2' = map (def1 `f`) ds2'
+ go ds1' [] = map (`f` def2) ds1'
+
-- | Compute the least upper bound of two 'DmdType's elicited /by the same
-- incoming demand/!
lubDmdType :: DmdType -> DmdType -> DmdType
-lubDmdType d1 d2 = DmdType lub_fv lub_ds
- where
- n = max (dmdTypeDepth d1) (dmdTypeDepth d2)
- (DmdType fv1 ds1) = etaExpandDmdType n d1
- (DmdType fv2 ds2) = etaExpandDmdType n d2
- lub_ds = zipWithEqual "lubDmdType" lubDmd ds1 ds2
- lub_fv = lubDmdEnv fv1 fv2
+lubDmdType = zipDmdType lubDmd
-- | Combine two 'DmdType's for stable unfolding analysis.
-- See Note [Combining demands for stable unfoldings].
maxDmdType :: DmdType -> DmdType -> DmdType
-maxDmdType (DmdType fv1 ds1) (DmdType fv2 ds2)
- = DmdType combined_fv combined_ds
- where
- combined_fv = maxDmdEnv fv1 fv2
- combined_ds = go ds1 ds2
- -- If lists have different lengths, keep remaining ds1 (from RHS)
- go rhs [] = rhs
- go [] _ = []
- go (r:rhs) (u:unfs) = maxDmd r u : go rhs unfs
-
--- | See Note [Combining demands for stable unfoldings].
-maxDmdEnv :: DmdEnv -> DmdEnv -> DmdEnv
-maxDmdEnv (DE fv1 d1) (DE fv2 d2) = DE combined_fv combined_div
- where
- combined_fv = plusVarEnv_CD maxDmd fv1 (defaultFvDmd d1) fv2 (defaultFvDmd d2)
- combined_div = lubDivergence d1 d2
+maxDmdType = zipDmdType maxDmd
discardArgDmds :: DmdType -> DmdEnv
discardArgDmds (DmdType fv _) = fv
=====================================
docs/index.html.in
=====================================
@@ -39,7 +39,7 @@
<LI>
<P>
- <B><A HREF="libraries/@LIBRARY_ghc_UNIT_ID@/index.html">GHC API</A></B>
+ <B><A HREF="libraries/@LIBRARY_ghc_ID@/index.html">GHC API</A></B>
</P>
<P>
Documentation for the GHC API.
=====================================
docs/users_guide/ghc_config.py.in
=====================================
@@ -15,16 +15,16 @@ else:
libs_base_uri = '../libraries'
-# N.B. If you add a package to this list be sure to also add a corresponding
-# LIBRARY_VERSION macro call to configure.ac.
+# N.B. If you add a package to this list be sure to also add it to
+# 'packageIds' in hadrian/src/Rules/Generate.hs.
lib_versions = {
- 'base': '@LIBRARY_base_UNIT_ID@',
- 'ghc-prim': '@LIBRARY_ghc_prim_UNIT_ID@',
- 'template-haskell': '@LIBRARY_template_haskell_UNIT_ID@',
- 'ghc-compact': '@LIBRARY_ghc_compact_UNIT_ID@',
- 'ghc': '@LIBRARY_ghc_UNIT_ID@',
- 'Cabal': '@LIBRARY_Cabal_UNIT_ID@',
- 'array': '@LIBRARY_array_UNIT_ID@',
+ 'base': '@LIBRARY_base_ID@',
+ 'ghc-prim': '@LIBRARY_ghc_prim_ID@',
+ 'template-haskell': '@LIBRARY_template_haskell_ID@',
+ 'ghc-compact': '@LIBRARY_ghc_compact_ID@',
+ 'ghc': '@LIBRARY_ghc_ID@',
+ 'Cabal': '@LIBRARY_Cabal_ID@',
+ 'array': '@LIBRARY_array_ID@',
}
version = '@ProjectVersion@'
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -320,13 +320,15 @@ packageVersions = foldMap f [ base, ghcPrim, compiler, ghc, cabal, templateHaske
f pkg = interpolateVar var $ version <$> readPackageData pkg
where var = "LIBRARY_" <> escapedPkgName pkg <> "_VERSION"
-packageUnitIds :: Stage -> Interpolations
-packageUnitIds stage =
+-- We don't want to use the hash in the html documentation because it
+-- makes it harder for non-boot packages to link to boot packages, see #26635
+packageIds :: Interpolations
+packageIds =
foldMap f [ base, ghcPrim, compiler, ghc, cabal, templateHaskell, ghcCompact, array ]
where
f :: Package -> Interpolations
- f pkg = interpolateVar var $ pkgUnitId stage pkg
- where var = "LIBRARY_" <> escapedPkgName pkg <> "_UNIT_ID"
+ f pkg = interpolateVar var $ pkgSimpleIdentifier pkg
+ where var = "LIBRARY_" <> escapedPkgName pkg <> "_ID"
escapedPkgName :: Package -> String
escapedPkgName = map f . pkgName
@@ -382,10 +384,10 @@ templateRules = do
, interpolateSetting "ProjectPatchLevel1" ProjectPatchLevel1
, interpolateSetting "ProjectPatchLevel2" ProjectPatchLevel2
]
- templateRule "docs/index.html" $ packageUnitIds Stage1
+ templateRule "docs/index.html" $ packageIds
templateRule "docs/users_guide/ghc_config.py" $ mconcat
[ projectVersion
- , packageUnitIds Stage1
+ , packageIds
, interpolateSetting "LlvmMinVersion" LlvmMinVersion
, interpolateSetting "LlvmMaxVersion" LlvmMaxVersion
]
=====================================
libraries/base/changelog.md
=====================================
@@ -2,6 +2,8 @@
## 4.21.3.0 *June 2026*
* System.Info.fullCompilerVersion: add 'since' annotation
+ * The implementation of `toException` in `SomeException`'s `Exception` instance no longer drops exception context, in keeping with the behavior originally proposed in [CLC Proposal #200](https://github.com/haskell/core-libraries-committee/issues/200).
+
## 4.21.2.0 *March 2026*
* Expose `Backtraces` constructor and fields ([CLC proposal #199](https://github.com/haskell/core-libraries-committee/issues/199), [#26049](https://gitlab.haskell.org/ghc/ghc/-/issues/26049))
=====================================
libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
=====================================
@@ -206,7 +206,16 @@ Caught MismatchedParentheses
-}
class (Typeable e, Show e) => Exception e where
- -- | @toException@ should produce a 'SomeException' with no attached 'ExceptionContext'.
+ -- | 'toException' converts an exception into the existential 'SomeException'
+ -- wrapper type.
+ --
+ -- In doing so, 'toException' should not /add/ an 'ExceptionContext'.
+ --
+ -- - In most cases, the exception does not store its own 'ExceptionContext'.
+ -- The default implementation of 'toException' (which does not store any
+ -- 'ExceptionContext') is suitable for these cases.
+ -- - In the rare case that the exception itself stores an 'ExceptionContext',
+ -- this context should be preserved by 'toException'.
toException :: e -> SomeException
fromException :: SomeException -> Maybe e
@@ -229,13 +238,11 @@ class (Typeable e, Show e) => Exception e where
-- | @since base-4.8.0.0
instance Exception Void
--- | This drops any attached 'ExceptionContext'.
+-- | NB: this instance preserves the attached 'ExceptionContext'.
--
-- @since base-3.0
instance Exception SomeException where
- toException (SomeException e) =
- let ?exceptionContext = emptyExceptionContext
- in SomeException e
+ toException = id
fromException = Just
backtraceDesired (SomeException e) = backtraceDesired e
displayException (SomeException e) = displayException e
=====================================
rts/sm/Evac.c
=====================================
@@ -1360,7 +1360,11 @@ selector_loop:
// from-space during marking, for example. We rely on the property
// that evacuate() doesn't mind if it gets passed a to-space pointer.
- info = RELAXED_LOAD((StgInfoTable**) &selectee->header.info);
+ // NB. this load must be ordered: the selectee may be updated
+ // concurrently by another GC thread's unchain_thunk_selectors(),
+ // which publishes an indirection by writing the indirectee and
+ // then RELEASE-storing the info pointer. See #27477.
+ info = ACQUIRE_LOAD((StgInfoTable**) &selectee->header.info);
if (IS_FORWARDING_PTR(info)) {
// We don't follow pointers into to-space; the constructor
=====================================
testsuite/tests/dmdanal/should_run/M2.hs
=====================================
@@ -0,0 +1,28 @@
+module M2 where
+
+-- f's stable unfolding template is the PAP `mk g`, which is not
+-- eta-expanded, so its DmdType has depth 0. The big lambda keeps the
+-- template large enough that f does not certainlyWillInline, so it is
+-- worker/wrappered.
+{-# INLINABLE [1] f #-}
+f :: Int -> Int -> Float
+f = mk (\y -> succ . succ . succ . succ . succ . succ . succ . succ . succ $ y)
+
+-- Arity 1: the `let` does real work, so mk is not eta-expanded past it.
+-- The returned function really forces x.
+{-# NOINLINE mk #-}
+mk :: (Int -> Int) -> Int -> Int -> Float
+mk t = let s = t 1 in \dummy x -> x `seq` fromIntegral (t (dummy + s))
+
+{-# INLINE mkFast #-}
+mkFast :: (Int -> Int) -> Int -> Int -> Float
+mkFast t = \dummy x -> fromIntegral (t dummy)
+
+-- Active only before phase 1: rewrites f's RHS early, but is dead by
+-- the time f's stable unfolding (activation [1]) is inlined at call
+-- sites.
+{-# RULES "mk" [~1] forall t. mk t = mkFast t #-}
+
+{-# NOINLINE g #-}
+g :: Int -> Int
+g x = x + 1
=====================================
testsuite/tests/dmdanal/should_run/T27626.hs
=====================================
@@ -0,0 +1,6 @@
+-- The raised threshold persuades GHC to inline the worker's stable
+-- unfolding in this small program; a larger program does that naturally.
+{-# OPTIONS_GHC -funfolding-use-threshold=400 #-}
+module Main where
+import M2 ( f )
+main = print (f 19 12)
=====================================
testsuite/tests/dmdanal/should_run/T27626.stdout
=====================================
@@ -0,0 +1 @@
+38.0
=====================================
testsuite/tests/dmdanal/should_run/all.T
=====================================
@@ -35,3 +35,4 @@ test('T22549', normal, compile_and_run, ['-fdicts-strict -fno-specialise'])
test('T23208', exit_code(1), multimod_compile_and_run, ['T23208_Lib', 'T23208'])
test('T25439', normal, compile_and_run, [''])
test('T26416', [extra_files(['M1.hs'])], multimod_compile_and_run, ['T26416','M1.hs'])
+test('T27626', [extra_files(['M2.hs'])], multimod_compile_and_run, ['T27626','M2.hs'])
=====================================
testsuite/tests/ghc-e/should_fail/T18441fail7.stderr
=====================================
@@ -1,10 +1,10 @@
-<interactive>: Uncaught exception ghc-9.13-inplace:GHC.Utils.Panic.GhcException:
+<interactive>: Uncaught exception ghc-9.12.4.20260710-inplace:GHC.Utils.Panic.GhcException:
IO error: "Abcde" does not exist
While handling IO error: "Abcde" does not exist
HasCallStack backtrace:
- throwIO, called at compiler/GHC/Utils/Error.hs:512:19 in ghc-9.13-inplace:GHC.Utils.Error
+ throwIO, called at compiler/GHC/Utils/Error.hs:512:19 in ghc-9.12.4.20260710-inplace:GHC.Utils.Error
1
=====================================
testsuite/tests/ghc-e/should_fail/T9930fail.stderr
=====================================
@@ -1,4 +1,4 @@
-ghc: Uncaught exception ghc-9.13-inplace:GHC.Utils.Panic.GhcException:
+ghc: Uncaught exception ghc-9.12.4.20260710-inplace:GHC.Utils.Panic.GhcException:
default output name would overwrite the input file; must specify -o explicitly
Usage: For basic information, try the `--help' option.
@@ -7,7 +7,12 @@ While handling default output name would overwrite the input file; must specify
| Usage: For basic information, try the `--help' option.
HasCallStack backtrace:
- throwIO, called at libraries/exceptions/src/Control/Monad/Catch.hs:371:13 in exceptions-0.10.12-inplace:Control.Monad.Catch
- throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:860:36 in exceptions-0.10.12-inplace:Control.Monad.Catch
- onException, called at compiler/GHC/Driver/Make.hs:2955:3 in ghc-9.13-inplace:GHC.Driver.Make
+ throwIO, called at libraries/exceptions/src/Control/Monad/Catch.hs:347:12 in exceptions-0.10.12-inplace:Control.Monad.Catch
+ throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:872:84 in exceptions-0.10.12-inplace:Control.Monad.Catch
+ onException, called at compiler/GHC/Driver/Make.hs:3025:23 in ghc-9.12.4.20260710-inplace:GHC.Driver.Make
+
+HasCallStack backtrace:
+ collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:170:37 in ghc-internal:GHC.Internal.Exception
+ toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:90:42 in ghc-internal:GHC.Internal.Exception
+ throw, called at compiler/GHC/Utils/Panic.hs:180:21 in ghc-9.12.4.20260710-inplace:GHC.Utils.Panic
=====================================
testsuite/tests/ghc-e/should_run/ghc-e005.stderr
=====================================
@@ -4,3 +4,8 @@ foo
HasCallStack backtrace:
error, called at ghc-e005.hs:12:10 in main:Main
+
+
+HasCallStack backtrace:
+ throwIO, called at ghc\GHCi\UI.hs:1655:31 in ghc-bin-10.1.20260629-inplace:GHCi.UI
+
=====================================
testsuite/tests/rts/T27477.hs
=====================================
@@ -0,0 +1,169 @@
+{-# LANGUAGE BangPatterns #-}
+
+-- Stress test for #27477: missing ACQUIRE in eval_thunk_selector
+-- (rts/sm/Evac.c).
+--
+-- With the bug present this test crashes or reports value mismatches
+-- within a few seconds on AArch64; on strongly-ordered targets
+-- it just passes.
+
+module Main (main) where
+
+import Control.Concurrent
+import Control.Exception
+import Control.Monad
+import Data.IORef
+import System.Environment
+import System.Exit
+import System.IO
+import System.Mem (performMinorGC)
+
+data T = T { nxt :: T, val :: !Int }
+
+-- expected values and the cells that should evaluate to them
+type Batch = ([Int], [T])
+
+tailD, branchD, branchesPerCell :: Int
+tailD = 12 -- shared tail length per cluster
+branchD = 3 -- private branch length
+branchesPerCell = 2
+-- tailD + branchD must stay below MAX_THUNK_SELECTOR_DEPTH (16)
+
+{-# NOINLINE spineEnd #-}
+spineEnd :: T
+spineEnd = errorWithoutStackTrace "spine end reached"
+
+-- Fully evaluated spine of constructors; cell i from the head has val i+1.
+buildSpine :: Int -> IO T
+buildSpine len = evaluate (go len (T spineEnd 0))
+ where
+ go :: Int -> T -> T
+ go 0 acc = acc
+ go k acc = go (k - 1) (T acc k)
+
+-- k selector thunks, shallow-first: cell i selects from cell i-1,
+-- cell 0 selects from t. If t evaluates to spine cell m (val m+1),
+-- cell i evaluates to spine cell m+1+i (val m+2+i).
+{-# NOINLINE selChain #-}
+selChain :: Int -> T -> [T]
+selChain 0 _ = []
+selChain k t = let t' = nxt t in t' : selChain (k - 1) t'
+
+lenL :: [a] -> Int
+lenL = go 0
+ where
+ go !n [] = n
+ go !n (_ : xs) = go (n + 1) xs
+
+everyN :: Int -> [a] -> [a]
+everyN _ [] = []
+everyN n (x : xs) = x : everyN n (drop (n - 1) xs)
+
+-- One branch hanging off tail cell tj (which evaluates to val jval):
+-- branch cell i evaluates to jval+1+i. Returned deepest-first.
+{-# NOINLINE mkBranch #-}
+mkBranch :: Int -> T -> IO Batch
+mkBranch jval tj = do
+ let cells = selChain branchD tj
+ _ <- evaluate (lenL cells)
+ let expected = [ jval + 1 + i | i <- [0 .. branchD - 1] ]
+ pure (reverse expected, reverse cells)
+
+-- A cluster: one private spine, one shared tail of selectors over it,
+-- branchesPerCell branches of selectors converging on every tail cell.
+-- Neither the spine nor the tail is returned: they must stay reachable
+-- only through the branch selectors.
+buildCluster :: IO [Batch]
+buildCluster = do
+ sp <- buildSpine (tailD + branchD + 4)
+ let tails = selChain tailD sp
+ _ <- evaluate (lenL tails)
+ bss <- forM (zip [0 ..] tails) $ \(j, tj) ->
+ replicateM branchesPerCell (mkBranch (j + 2) tj)
+ pure (concat bss)
+
+verifyBatch :: IORef Int -> Int -> Batch -> IO ()
+verifyBatch errs wid (es0, ts0) = go es0 ts0
+ where
+ go (e : es) (t : ts) = do
+ v <- evaluate (val t)
+ when (v /= e) $ do
+ hPutStrLn stderr $
+ "MISMATCH worker=" ++ show wid
+ ++ " expected=" ++ show e ++ " got=" ++ show v
+ modifyIORef' errs (+ 1)
+ go es ts
+ go _ _ = pure ()
+
+-- simple cyclic barrier
+newtype Barrier = Barrier (MVar (Int, [MVar ()]))
+
+newBarrier :: IO Barrier
+newBarrier = Barrier <$> newMVar (0, [])
+
+awaitBarrier :: Barrier -> Int -> IO ()
+awaitBarrier (Barrier st) total = do
+ w <- newEmptyMVar
+ join $ modifyMVar st $ \(k, ws) ->
+ if k + 1 == total
+ then pure ((0, []), mapM_ (\m -> putMVar m ()) ws)
+ else pure ((k + 1, w : ws), takeMVar w)
+
+worker :: Int -> Int -> Int -> Barrier -> [IORef [Batch]] -> IORef Int -> Int -> IO ()
+worker rounds clusters nWorkers bar slots errs wid =
+ forM_ [1 .. rounds] $ \(_r :: Int) -> do
+ -- build fresh selector clusters, publish them
+ batches <- concat <$> replicateM clusters buildCluster
+ writeIORef (slots !! wid) batches
+ awaitBarrier bar nWorkers
+ -- root each branch's deepest cell via fresh cons cells in our own
+ -- nursery (so our GC thread evacuates the shared cells itself), in
+ -- a per-worker interleaved order so that different GC threads
+ -- sweep different branches of the same shared tails concurrently
+ published <- mapM readIORef slots
+ let allBatches = concat published
+ ordered
+ | nWorkers > 1 =
+ concat [ everyN nWorkers (drop ((wid + k) `mod` nWorkers) allBatches)
+ | k <- [0 .. nWorkers - 1] ]
+ | otherwise = allBatches
+ deepTs = [ t | (_, t : _) <- ordered ]
+ deepEs = [ e | (e : _, _) <- ordered ]
+ _ <- evaluate (lenL deepTs)
+ _ <- evaluate (lenL deepEs)
+ awaitBarrier bar nWorkers
+ -- run a parallel GC with everything live
+ when (wid == 0) performMinorGC
+ awaitBarrier bar nWorkers
+ -- force everything and check the values
+ verifyBatch errs wid (deepEs, deepTs)
+ awaitBarrier bar nWorkers
+
+main :: IO ()
+main = do
+ hSetBuffering stderr LineBuffering
+ args <- getArgs
+ let atDef d i = if length args > i then read (args !! i) else d
+ rounds = atDef 600 0
+ clusters = atDef 48 1
+ n <- getNumCapabilities
+ bar <- newBarrier
+ slots <- replicateM n (newIORef [])
+ errs <- newIORef 0
+ dones <- forM [0 .. n - 1] $ \i -> do
+ done <- newEmptyMVar
+ _ <- forkOn i $
+ (worker rounds clusters n bar slots errs i >> putMVar done Nothing)
+ `catch` \e -> putMVar done (Just (e :: SomeException))
+ pure done
+ results <- mapM takeMVar dones
+ forM_ results $ \r -> case r of
+ Just e -> do
+ hPutStrLn stderr ("worker exception: " ++ show e)
+ exitWith (ExitFailure 2)
+ Nothing -> pure ()
+ ec <- readIORef errs
+ when (ec > 0) $ do
+ hPutStrLn stderr ("FAILED: " ++ show ec ++ " mismatches")
+ exitWith (ExitFailure 2)
+ putStrLn "OK"
=====================================
testsuite/tests/rts/T27477.stdout
=====================================
@@ -0,0 +1 @@
+OK
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -639,5 +639,11 @@ test('T25280', [unless(opsys('linux'),skip),req_process,js_skip], compile_and_ru
test('T25560', [req_c_rts, ignore_stderr], compile_and_run, [''])
test('TestProddableBlockSet', [req_c_rts], multimod_compile_and_run, ['TestProddableBlockSet.c', '-no-hs-main'])
-
test('T27123', [when(have_profiling(), extra_ways(['prof']))], compile_and_run, ['-O -package ghc'])
+test('T27477',
+ [ extra_run_opts('600 24 +RTS -N4 -A1m -RTS')
+ , req_ghc_smp
+ , req_target_smp
+ , only_ways(['threaded1', 'threaded2'])
+ ],
+ compile_and_run, ['-O2'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/329cbb816d6db5a97a82ddcab635aa…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/329cbb816d6db5a97a82ddcab635aa…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/jeltsch/ghc-9-14-building-base] Disable the inclusion of `GHC.Essentials` for older GHCs
by Wolfgang Jeltsch (＠jeltsch) 09 Sep '26
by Wolfgang Jeltsch (＠jeltsch) 09 Sep '26
09 Sep '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/ghc-9-14-building-base at Glasgow Haskell Compiler / GHC
Commits:
3fb46764 by Wolfgang Jeltsch at 2026-09-09T14:17:06+03:00
Disable the inclusion of `GHC.Essentials` for older GHCs
- - - - -
1 changed file:
- libraries/base/base.cabal.in
Changes:
=====================================
libraries/base/base.cabal.in
=====================================
@@ -308,9 +308,11 @@ Library
other-modules:
Data.List.NubOrdSet
- GHC.Essentials
System.CPUTime.Unsupported
System.CPUTime.Utils
+ if impl(ghc >= 10.1)
+ other-modules:
+ GHC.Essentials
if os(windows)
other-modules:
System.CPUTime.Windows
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3fb46764503ae051f152940410a0d1c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3fb46764503ae051f152940410a0d1c…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/dcoutts/printf-warnings] 13 commits: Parentheses in prefix GADT constructors (#27423)
by Duncan Coutts (＠dcoutts) 09 Sep '26
by Duncan Coutts (＠dcoutts) 09 Sep '26
09 Sep '26
Duncan Coutts pushed to branch wip/dcoutts/printf-warnings at Glasgow Haskell Compiler / GHC
Commits:
eaa95a6f by Andrei Borzenkov at 2026-09-04T08:08:40-04:00
Parentheses in prefix GADT constructors (#27423)
Updated `splitLHsGadtTy` to allow looking
through the parentheses for inner binders. General example
of a code pattern that's allowed now:
data S a where
MkS :: (forall a. S a)
That should work now with any combination of nested
foralls and parentheses.
We don't perform parenthesis unwrapping for record
GADT constructors in accordance with GHC Proposal #402.
To this end `con_inner_bndrs` no longer stores plain forall
telescopes: `[HsForAllTelescope pass]` is replaced with
`[LHsGadtTelescope pass]`, a new `HsArg`-style type whose
`HsGadtForAll` holds an inner telescope and whose `HsGadtPar`
holds a pair of parentheses. The parentheses carry no meaning
for renaming or type checking; the only reason to record them
is exact-printing.
Updated `pprConDecl` to improve the `parse == parse . ppr . parse`
property of GADT pretty-printing.
The pretty printer can now output code that's similar to this:
data T a where
MkT1 :: (forall a. T a)
MkT2 :: forall . forall a. T a
These are special cases of inner forall binders
for prefix GADT constructors, when we have either
implicit or zero explicit outer binders.
- - - - -
639456a8 by Evgeny Malyshev at 2026-09-04T08:09:25-04:00
HsPat: Add spacing to unary tuple patterns
Use hsep when printing unary boxed TuplePat applications so that the
MkSolo constructor is separated from its argument. The old hcat rendered
wildcard and parenthesized arguments as MkSolo_ and MkSolo().
Add T27034 to exercise the HsPat splice-dump path with wildcard and
variable arguments, and update existing affected golden output.
Fixes #27034
Assisted-By: OpenAI Codex
- - - - -
2908ab36 by Simon Jakobi at 2026-09-05T07:22:17-04:00
X86 NCG: use btr/bts/btc for single-bit operations
Previously the Cmm patterns
x & ~(1 << i)
x | (1 << i)
x ^ (1 << i)
compiled to mov/shl/not/and-style sequences of 3-4 instructions. Now
they compile to a single btr, bts or btc, matching what C compilers
produce.
When the bit index is a literal, constant folding has already collapsed
these patterns into ones with a literal mask, such as
x & 0xfffffeffffffffff for x & ~(1 << 40). Such masks are now also
compiled to a bit-test instruction when they don't fit in an imm32 and
would otherwise have to be loaded into a register first.
For a variable bit index, this applies only when the shift is unchecked
(uncheckedShiftL#, Data.Bits.unsafeShiftL): the bounds-checked shiftL
used by e.g. the default clearBit/setBit/complementBit implementations
wraps the shift in a bounds mask that this optimisation does not see
through. With a literal index, the bounds mask is constant-folded away,
so the checked operations benefit too.
See Note [Bit-test instructions] in GHC.CmmToAsm.X86.CodeGen.
Fixes #25233.
Assisted-by: Claude Fable 5
- - - - -
c673ecf0 by Simon Peyton Jones at 2026-09-05T07:22:59-04:00
Move HsStatic free-var test to typechecker
A `static` form should have no free *term* variables, but it
can have free *type* variables. Alas, the renamer does not really know what
is a term variable and what is a type variable, because of required type
arguments. This patch moves the test to the typechecker, which does know.
Addresses #27664
- - - - -
5939ceaf by sheaf at 2026-09-05T22:06:18-04:00
Windows: enforce path convention in ./configure
As detailed in Note [MSYS paths] in Hadrian.Utilities, the standing
convention (using Windows-style paths with forward slashes) is now
enforced in ./configure instead of within Hadrian, removing the need for
'cygpath' calls within Hadrian.
Fixes #26683
- - - - -
a6061455 by sheaf at 2026-09-05T22:06:18-04:00
Hadrian: introduce ExeSpawnPath
Specific details about the filepath used to specify the executable to
spawn with CreateProcess matters on Windows: whether we use forward or
backward slashes, a leading ./, or an absolute path changes how the
executable is found.
This commit introduces 'ExeSpawnPath' which is a path that is guaranteed
to be found when spawning a process. All command invocations now go
through this type to ensure the path has been properly sanitised.
See Note [NeedCurrentDirectoryForExePath] in Hadrian.Utilities.
The same treatment is applied to hsc2hs. Updates hsc2hs submodule.
- - - - -
e28313e3 by sheaf at 2026-09-05T22:07:06-04:00
Preserve tick ordering in 'tickTickedExpr'
'GHC.Core.Utils.tickTickedExpr' tries to combine a tick 't1' into an
existing stack of ticks 't2s'. There are two situations:
1. 't1' is subsumed by a tick in 't2s': drop it.
2. A tick in 't2s' is subsumed by 't1', say 't2'.
This commit ensures that in case (2) we keep 't1' on the outside instead
of replacing 't2' at its position in the stack. This avoids re-ordering
source notes (which was the cause of #27749).
This fixes a regression introduced in 2dadf3b0d05.
Fixes #27749
- - - - -
3172f557 by sheaf at 2026-09-05T22:07:06-04:00
Consistently prefer local source note ticks
GHC.Cmm.DebugBlock.cmmDebugGen (DWARF annotations) and
GHC.Stg.Debug.quickSourcePos (-finfo-table-map) both contained logic to
prioritise source note ticks from the current module.
This commit commons up this logic and propagates it to a third consumer:
IPE stack frames, in GHC.Driver.GenerateCgIPEStub.
See the new function GHC.Types.Tickish.bestSourceNote.
- - - - -
192be0b6 by Luite Stegeman at 2026-09-07T19:43:36-04:00
rts: fix ctoi_tuple_spill_words getting out of sync
Fix a few places that were not updating ctoi_tuple_spill_words
correctly, leading to corruption/crashes when dealing with large
unboxed tuples in bytecode:
- captureContinuationAndAbort
- findRetryFrameHelper/findAtomicallyFrameHelper
- interpretBCO bci_BRK_FUN
fixes #27633
- - - - -
604eb43c by Simon Jakobi at 2026-09-07T19:44:15-04:00
Hadrian: don't capture the testsuite driver's output (#27780)
a6061455d54 switched the Testsuite RunTest case from Shake's cmd to the
cmd' wrapper. cmd' always captures stdout and stderr, and since the
caller asks for Exit, it returns without dumping what it captured. As a
result the testsuite output no longer appears in CI job logs: failures,
performance metrics and the summary were lost with the job.
Use cmdExe, the uncaptured cmd, as the other plain-cmd sites in that
commit do.
Fixes #27780.
Assisted-by: Claude Fable 5.1
- - - - -
06eee015 by Luite Stegeman at 2026-09-08T06:03:06+02:00
rts: Fix missing memory barrier in eval_thunk_selector (#27477)
unchain_thunk_selectors() was missing an ACQUIRE_LOAD for the
indirectee, leading to segfaults and corruption during GC on
weakly-ordered architectures.
Fixes #27477
- - - - -
f8b2bd8f by Alan Zimmerman at 2026-09-08T09:39:12-04:00
EPA Fix HsCmdDo exact print with comments
Exact printing of HsCmdDo was ignoring the location for the do
statements, and this is an annotation that can have comments in it.
Update it so we print the statements as a unit, including any
comments.
Also add the result of auditing that we capture comments in all needed
places, noting that the remaining Anno SrcSpan instances are benign.
- - - - -
45414045 by Duncan Coutts at 2026-09-09T11:07:13+01:00
Enable printf warnings for trace functions and fix resulting warnings
Most of the existing printf-style functions are annotated with
attributes to enable gcc/clang warnings for the printf format string,
but several trace functions in Trace.h were missing this annotation.
Enable them, and fix the resulting warnings.
- - - - -
130 changed files:
- + changelog.d/T27749
- + changelog.d/T27764
- + changelog.d/allow-gadt-prefix-con-parens
- + changelog.d/fix-parallel-gc-selector-race-27477
- + changelog.d/ncg-x86-bit-test-instructions
- compiler/GHC/Cmm/DebugBlock.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/Driver/GenerateCgIPEStub.hs
- compiler/GHC/Driver/Main/Compile.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Doc.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Extension/Pass.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Stg/Debug.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Types/Tickish.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- compiler/Language/Haskell/Syntax/Type.hs
- configure.ac
- docs/users_guide/exts/gadt_syntax.rst
- hadrian/src/Base.hs
- hadrian/src/Builder.hs
- hadrian/src/Hadrian/Builder.hs
- hadrian/src/Hadrian/Builder/Ar.hs
- hadrian/src/Hadrian/Oracles/Path.hs
- hadrian/src/Hadrian/Utilities.hs
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Oracles/TestSettings.hs
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Rules/Changelog.hs
- hadrian/src/Rules/Codes.hs
- hadrian/src/Rules/Lint.hs
- hadrian/src/Rules/Nofib.hs
- hadrian/src/Rules/Test.hs
- m4/find_python.m4
- + m4/fp_canonicalise_win_path.m4
- m4/fp_find_nm.m4
- m4/fp_find_root.m4
- m4/fp_prog_ar.m4
- m4/fp_prog_ar_args.m4
- m4/fp_prog_sh.m4
- m4/fptools_alex.m4
- m4/fptools_happy.m4
- rts/Capability.c
- rts/Continuation.c
- rts/IOManager.c
- rts/Interpreter.c
- rts/Messages.c
- rts/Printer.c
- rts/STM.c
- rts/Schedule.c
- rts/Sparks.c
- rts/StableName.c
- rts/ThreadPaused.c
- rts/Threads.c
- rts/Trace.h
- rts/posix/Poll.c
- rts/posix/Timeout.c
- rts/sm/Compact.c
- rts/sm/Evac.c
- rts/sm/GC.c
- rts/sm/GCUtils.c
- rts/sm/MBlock.c
- rts/sm/NonMoving.c
- rts/sm/NonMovingMark.c
- rts/sm/Storage.c
- rts/sm/Sweep.c
- + testsuite/tests/bytecode/T27633/Obj.hs
- + testsuite/tests/bytecode/T27633/T27633a.hs
- + testsuite/tests/bytecode/T27633/T27633a.stdout
- + testsuite/tests/bytecode/T27633/T27633b.hs
- + testsuite/tests/bytecode/T27633/T27633b.stdout
- + testsuite/tests/bytecode/T27633/all.T
- + testsuite/tests/codeGen/should_gen_asm/T25233.asm
- + testsuite/tests/codeGen/should_gen_asm/T25233.hs
- + testsuite/tests/codeGen/should_gen_asm/T25233b.asm
- + testsuite/tests/codeGen/should_gen_asm/T25233b.cmm
- testsuite/tests/codeGen/should_gen_asm/all.T
- − testsuite/tests/gadt/T14320.stderr
- testsuite/tests/gadt/T18191.hs
- testsuite/tests/gadt/T18191.stderr
- + testsuite/tests/gadt/T27423a.hs
- + testsuite/tests/gadt/T27423b.hs
- + testsuite/tests/gadt/T27423b.stderr
- testsuite/tests/gadt/all.T
- + testsuite/tests/ghci.debugger/scripts/T27633c.hs
- + testsuite/tests/ghci.debugger/scripts/T27633c.script
- + testsuite/tests/ghci.debugger/scripts/T27633c.stdout
- + testsuite/tests/ghci.debugger/scripts/T27633c_obj.hs
- testsuite/tests/ghci.debugger/scripts/all.T
- testsuite/tests/printer/Makefile
- + testsuite/tests/printer/T27423c.hs
- testsuite/tests/printer/all.T
- testsuite/tests/rename/should_fail/RnStaticPointersFail01.stderr
- testsuite/tests/rename/should_fail/RnStaticPointersFail03.stderr
- testsuite/tests/rename/should_fail/T26545.stderr
- + testsuite/tests/rts/T27477.hs
- + testsuite/tests/rts/T27477.stdout
- testsuite/tests/rts/all.T
- + testsuite/tests/simplCore/should_compile/T27749.hs
- + testsuite/tests/simplCore/should_compile/T27749.stderr
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/th/T17380.stderr
- testsuite/tests/th/T18612.stderr
- + testsuite/tests/th/T27034.hs
- + testsuite/tests/th/T27034.stderr
- testsuite/tests/th/T8761.stderr
- testsuite/tests/th/all.T
- + testsuite/tests/typecheck/should_compile/T27664.hs
- testsuite/tests/typecheck/should_compile/all.T
- utils/check-exact/ExactPrint.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
- utils/hsc2hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21b4e75910bf9a62869bfd45e4c81e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21b4e75910bf9a62869bfd45e4c81e…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0