Marge Bot pushed to branch wip/marge_bot_batch_merge_job 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. - - - - - 9a442c93 by Alan Zimmerman at 2026-09-09T20:09:36-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. - - - - - 8062c008 by Simon Jakobi at 2026-09-10T06:00:34-04:00 ci: Actually pass --ignore-perf-failures to the testsuite driver 684c0018d9 changed the IGNORE_PERF_FAILURES handling to append to RUNTEST_ARGS with bash array syntax, but the three use sites still expand RUNTEST_ARGS as a scalar, which yields only the first array element. The appended flag was therefore dropped in every job, so perf improvements kept failing Marge Bot batches and master pipelines, contrary to #19562. Append as a string instead, matching the existing --force-colors append in test_hadrian. Fixes #27563. Assisted-by: Claude Fable 5.1 - - - - - 815439bc by Simon Jakobi at 2026-09-10T06:00:35-04: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 - - - - - 24 changed files: - .gitlab/ci.sh - 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 - testsuite/tests/codeGen/should_run/all.T - utils/check-exact/ExactPrint.hs Changes: ===================================== .gitlab/ci.sh ===================================== @@ -1106,7 +1106,7 @@ if [ "${CI_COMMIT_BRANCH:-}" == "master" ] && [ "${CI_PROJECT_PATH:-}" == "ghc/ fi fi if [ -n "${IGNORE_PERF_FAILURES:-}" ]; then - RUNTEST_ARGS=( "${RUNTEST_ARGS[@]:-}" "--ignore-perf-failures=$IGNORE_PERF_FAILURES" ) + RUNTEST_ARGS="${RUNTEST_ARGS:-} --ignore-perf-failures=$IGNORE_PERF_FAILURES" fi if [[ -z ${BIGNUM_BACKEND:-} ]]; then BIGNUM_BACKEND=gmp; fi ===================================== 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, ===================================== 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 ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -370,10 +370,6 @@ cua CanUpdateAnchor f = f cua CanUpdateAnchorOnly _ = return [] cua NoCanUpdateAnchor _ = return [] -enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a -enterAnn = enterAnnWith exact setAnnotationAnchor - -{-# INLINE enterAnnWith #-} -- | "Enter" an annotation, by using the associated 'anchor' field as -- the new reference point for calculating all DeltaPos positions. -- This is the heart of the exact printing process. @@ -381,17 +377,14 @@ enterAnn = enterAnnWith exact setAnnotationAnchor -- 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. -enterAnnWith :: (Monad m, Monoid w, Typeable a, Typeable b) => - (a -> EP w m b) -> -- exact - (b -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> b) -> -- setAnnotationAnchor - Entry -> a -> EP w m b -enterAnnWith exactVia _ NoEntryVal a = do +enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a +enterAnn NoEntryVal a = do p <- getPosP debugM $ "enterAnn:starting:NO ANN:(p,a) =" ++ show (p, astId a) - r <- exactVia a + r <- exact a debugM $ "enterAnn:done:NO ANN:p =" ++ show (p, astId a) return r -enterAnnWith exactVia setAnnAnchor !(Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do +enterAnn !(Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do acceptSpan <- getAcceptSpan setAcceptSpan False case anchor' of @@ -502,7 +495,7 @@ enterAnnWith exactVia setAnnAnchor !(Entry anchor' trailing_anns cs flush canUpd advance edp debugM $ "enterAnn:exact a starting:" ++ show (showAst anchor') - a' <- exactVia a + a' <- exact a debugM $ "enterAnn:exact a done:" ++ show (showAst anchor') -- Core recursive exactprint done, start end of Entry processing @@ -556,8 +549,8 @@ enterAnnWith exactVia setAnnAnchor !(Entry anchor' trailing_anns cs flush canUpd EpaSpan s -> EpaDelta s edp [] _ -> EpaDelta noSrcSpan edp [] let r = case canUpdateAnchor of - CanUpdateAnchor -> setAnnAnchor a' newAnchor trailing' (mkEpaComments priorCs postCs) - CanUpdateAnchorOnly -> setAnnAnchor a' newAnchor [] emptyComments + CanUpdateAnchor -> setAnnotationAnchor a' newAnchor trailing' (mkEpaComments priorCs postCs) + CanUpdateAnchorOnly -> setAnnotationAnchor a' newAnchor [] emptyComments NoCanUpdateAnchor -> a' return r @@ -4264,26 +4257,13 @@ instance ExactPrint (ConDecl GhcPs) where epTokensToComments "(" ops epTokensToComments ")" cps - -- Work around https://gitlab.haskell.org/ghc/ghc/-/issues/20558 outer_bndrs' <- case outer_bndrs of L _ (HsOuterImplicit _) -> return outer_bndrs _ -> markAnnotated outer_bndrs - (inner_bndrs', (mcxt', args', res_ty')) <- markGadtArgs inner_bndrs $ do - mcxt' <- markAnnotated mcxt - args' <- - case args of - (PrefixConGADT x args0) -> do - args0' <- mapM markAnnotated args0 - return (PrefixConGADT x args0') - (RecConGADT (oc,cc,rarr) fields) -> do - oc' <- markEpToken oc - fields' <- markAnnotated fields - cc' <- markEpToken cc - rarr' <- markEpUniToken rarr - return (RecConGADT (oc',cc',rarr') fields') - res_ty' <- markAnnotated res_ty - return (mcxt', args', res_ty') + let ib = toInnerBindings inner_bndrs (mcxt, args, res_ty) + ib' <- markAnnotated ib + let (inner_bndrs', (mcxt', args', res_ty')) = fromInnerBindings ib' return (ConDeclGADT { con_g_ext = AnnConDeclGADT [] [] dcol' , con_names = cons' @@ -4293,43 +4273,54 @@ instance ExactPrint (ConDecl GhcPs) where , con_modifiers = mods' , con_res_ty = res_ty', con_doc = doc }) --- | Exact print the inner binders of a GADT signature. --- --- It's that complicated because we need to mark comments/trailing anns --- stored inside `L` and mark closing parenthesis _after_ we mark inner --- type: --- --- data T a b where --- MkT :: --- forall a. ( -- mark inside `markGadtArgs` --- forall b. some type -> T a b -- mark everything there --- ) -- mark inside `markGadtArgs` --- --- We don't have the same problem for `HsArgPar` because we ignore it --- during exact-print, "Does not appear in original source" -markGadtArgs :: (Monad m, Monoid w, Typeable a) - => [LHsGadtTelescope GhcPs] -> EP w m a - -> EP w m ([LHsGadtTelescope GhcPs], a) -markGadtArgs args inner_action = go args +-- --------------------------------------------------------------------- + +data InnerBindings + = InnerMore (LHsGadtTelescope GhcPs) InnerBindings + | InnerDone (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs) + +toInnerBindings :: [LHsGadtTelescope GhcPs] + -> (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs) -> InnerBindings +toInnerBindings [] inner = InnerDone inner +toInnerBindings (b:bs) inner = InnerMore b (toInnerBindings bs inner) + +fromInnerBindings :: InnerBindings -> ([LHsGadtTelescope GhcPs], (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs)) +fromInnerBindings = go [] where - go [] = do - r <- inner_action - return ([], r) - go (arg:xs) = enterAnnWith (exact_arg xs) setAnchor (entryFromLocatedA arg) arg - - exact_arg xs (L l (HsGadtForAll _ tele)) = do - tele' <- markAnnotated tele - (xs', r) <- go xs - return (L l (HsGadtForAll noExtField tele') : xs', r) - exact_arg xs (L l (HsGadtPar (lp, rp))) = do - lp' <- markEpToken lp - (xs', r) <- go xs - rp' <- markEpToken rp - return (L l (HsGadtPar (lp',rp')) : xs', r) - - -- The binder just entered is the head of the returned list - setAnchor (arg':xs', r) anc ts cs = (setAnchorAn arg' anc ts cs : xs', r) - setAnchor ([], r) _ _ _ = ([], r) + go acc (InnerMore b n) = go (b:acc) n + go acc (InnerDone x) = (acc,x) + +instance ExactPrint InnerBindings where + getAnnotationEntry (InnerMore (L li _) _) = fromAnn li + getAnnotationEntry (InnerDone _) = NoEntryVal + + setAnnotationAnchor (InnerMore li n) anc ts cs = InnerMore (setAnchorAn li anc ts cs) n + setAnnotationAnchor (InnerDone x) _ _ _ = InnerDone x + + exact (InnerMore (L li (HsGadtForAll x tele)) n) = do + tele' <- markAnnotated tele + n' <- markAnnotated n + return (InnerMore (L li (HsGadtForAll x tele')) n') + 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') + exact (InnerDone (mcxt, args, res_ty)) = do + mcxt' <- markAnnotated mcxt + args' <- + case args of + (PrefixConGADT x args0) -> do + args0' <- mapM markAnnotated args0 + return (PrefixConGADT x args0') + (RecConGADT (oc,cc,rarr) fields) -> do + oc' <- markEpToken oc + fields' <- markAnnotated fields + cc' <- markEpToken cc + rarr' <- markEpUniToken rarr + return (RecConGADT (oc',cc',rarr') fields') + res_ty' <- markAnnotated res_ty + return (InnerDone (mcxt', args', res_ty')) -- --------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed800f8c19eebf8b525600791fc9d88... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed800f8c19eebf8b525600791fc9d88... 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