Corrected types of thread ids obtained from the RTS

While the thread ids had been changed to 64 bit words in
e57b7cc6d8b1222e0939d19c265b51d2c3c2b4c0 the return type of the foreign
import function used to retrieve these ids - namely
'GHC.Conc.Sync.getThreadId' - was never updated accordingly.
In order to fix that this function returns now a 'CUULong'.

In addition to that the types used in the thread labeling subsystem were
adjusted as well and several format strings were modified throughout the
whole RTS to display thread ids in a consistent and correct way.

Fixes #16761

11 files changed, 54 insertions, 47 deletions

diff --git a/rts/Messages.c b/rts/Messages.c
index 2ec12da3ad..d4a51f4ea6 100644
--- a/rts/Messages.c
+++ b/rts/Messages.c
@@ -74,8 +74,8 @@ loop:
     if (i == &stg_MSG_TRY_WAKEUP_info)
     {
         StgTSO *tso = ((MessageWakeup *)m)->tso;
-        debugTraceCap(DEBUG_sched, cap, "message: try wakeup thread %ld",
-                      (W_)tso->id);
+        debugTraceCap(DEBUG_sched, cap, "message: try wakeup thread %"
+                      FMT_StgThreadID, tso->id);
         tryWakeupThread(cap, tso);
     }
     else if (i == &stg_MSG_THROWTO_info)
@@ -171,8 +171,8 @@ uint32_t messageBlackHole(Capability *cap, MessageBlackHole *msg)
     StgClosure *bh = UNTAG_CLOSURE(msg->bh);
     StgTSO *owner;
 
-    debugTraceCap(DEBUG_sched, cap, "message: thread %d blocking on "
-                  "blackhole %p", (W_)msg->tso->id, msg->bh);
+    debugTraceCap(DEBUG_sched, cap, "message: thread %" FMT_StgThreadID
+                  " blocking on blackhole %p", msg->tso->id, msg->bh);
 
     info = ACQUIRE_LOAD(&bh->header.info);
 
@@ -268,8 +268,8 @@ loop:
         }
         recordClosureMutated(cap,bh); // bh was mutated
 
-        debugTraceCap(DEBUG_sched, cap, "thread %d blocked on thread %d",
-                      (W_)msg->tso->id, (W_)owner->id);
+        debugTraceCap(DEBUG_sched, cap, "thread %" FMT_StgThreadID " blocked on"
+                      " thread %" FMT_StgThreadID, msg->tso->id, owner->id);
 
         return 1; // blocked
     }
@@ -312,9 +312,9 @@ loop:
         }
 
         debugTraceCap(DEBUG_sched, cap,
-                      "thread %d blocked on existing BLOCKING_QUEUE "
-                      "owned by thread %d",
-                      (W_)msg->tso->id, (W_)owner->id);
+                      "thread %" FMT_StgThreadID " blocked on existing "
+                      "BLOCKING_QUEUE owned by thread %" FMT_StgThreadID,
+                      msg->tso->id, owner->id);
 
         // See above, #3838
         if (owner->why_blocked == NotBlocked && owner->id != msg->tso->id) {
diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index 022999acdc..a0719024b4 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -559,7 +559,8 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso)
 
     if (tso->blocked_exceptions != END_BLOCKED_EXCEPTIONS_QUEUE &&
         (tso->flags & TSO_BLOCKEX) != 0) {
-        debugTraceCap(DEBUG_sched, cap, "throwTo: thread %lu has blocked exceptions but is inside block", (unsigned long)tso->id);
+        debugTraceCap(DEBUG_sched, cap, "throwTo: thread %" FMT_StgThreadID
+                      " has blocked exceptions but is inside block", tso->id);
     }
 
     if (tso->blocked_exceptions != END_BLOCKED_EXCEPTIONS_QUEUE
@@ -782,7 +783,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
     StgStack *stack;
 
     debugTraceCap(DEBUG_sched, cap,
-                  "raising exception in thread %ld.", (long)tso->id);
+                  "raising exception in thread %" FMT_StgThreadID ".", tso->id);
 
 #if defined(PROFILING)
     /*
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 3306f00ff3..4fe18fa769 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -1358,7 +1358,7 @@ scheduleHandleThreadFinished (Capability *cap, Task *task, StgTSO *t)
               }
           }
 
-          removeThreadLabel((StgWord)task->incall->tso->id);
+          removeThreadLabel(task->incall->tso->id);
 
           // We no longer consider this thread and task to be bound to
           // each other.  The TSO lives on until it is GC'd, but the
@@ -2646,7 +2646,7 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability **pcap)
     appendToRunQueue(cap,tso);
 
     DEBUG_ONLY( id = tso->id );
-    debugTrace(DEBUG_sched, "new bound thread (%lu)", (unsigned long)id);
+    debugTrace(DEBUG_sched, "new bound thread (%" FMT_StgThreadID ")", id);
 
     // As the TSO is bound and on the run queue, schedule() will run the TSO.
     cap = schedule(cap,task);
@@ -2654,7 +2654,7 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability **pcap)
     ASSERT(task->incall->rstat != NoStatus);
     ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
 
-    debugTrace(DEBUG_sched, "bound thread (%lu) finished", (unsigned long)id);
+    debugTrace(DEBUG_sched, "bound thread (%" FMT_StgThreadID ") finished", id);
     *pcap = cap;
 }
 
@@ -3198,7 +3198,7 @@ resurrectThreads (StgTSO *threads)
         tso->global_link = gen->threads;
         gen->threads = tso;
 
-        debugTrace(DEBUG_sched, "resurrecting thread %lu", (unsigned long)tso->id);
+        debugTrace(DEBUG_sched, "resurrecting thread %" FMT_StgThreadID, tso->id);
 
         // Wake up the thread on the Capability it was last on
         cap = tso->cap;
diff --git a/rts/Task.c b/rts/Task.c
index 3cfe6e1769..5c6d3cdf44 100644
--- a/rts/Task.c
+++ b/rts/Task.c
@@ -565,8 +565,8 @@ printAllTasks(void)
                 debugBelch("on capability %d, ", task->cap->no);
             }
             if (task->incall->tso) {
-              debugBelch("bound to thread %lu",
-                         (unsigned long)task->incall->tso->id);
+              debugBelch("bound to thread %" FMT_StgThreadID,
+                         task->incall->tso->id);
             } else {
                 debugBelch("worker");
             }
diff --git a/rts/ThreadLabels.c b/rts/ThreadLabels.c
index ad72141dce..5b3362a2b8 100644
--- a/rts/ThreadLabels.c
+++ b/rts/ThreadLabels.c
@@ -50,7 +50,7 @@ freeThreadLabelTable(void)
 }
 
 static void
-updateThreadLabel(StgWord key, void *data)
+updateThreadLabel(StgThreadID key, void *data)
 {
   removeThreadLabel(key);
 
@@ -62,7 +62,7 @@ updateThreadLabel(StgWord key, void *data)
 }
 
 void *
-lookupThreadLabel(StgWord key)
+lookupThreadLabel(StgThreadID key)
 {
   void * result;
   ACQUIRE_LOCK(&threadLabels_mutex);
@@ -75,7 +75,7 @@ lookupThreadLabel(StgWord key)
 }
 
 void
-removeThreadLabel(StgWord key)
+removeThreadLabel(StgThreadID key)
 {
   ACQUIRE_LOCK(&threadLabels_mutex);
 
diff --git a/rts/ThreadLabels.h b/rts/ThreadLabels.h
index 0837cb53fd..2ca75d0bac 100644
--- a/rts/ThreadLabels.h
+++ b/rts/ThreadLabels.h
@@ -13,8 +13,8 @@
 
 void    initThreadLabelTable (void);
 void    freeThreadLabelTable (void);
-void *  lookupThreadLabel    (StgWord key);
-void    removeThreadLabel    (StgWord key);
+void *  lookupThreadLabel    (StgThreadID key);
+void    removeThreadLabel    (StgThreadID key);
 void    labelThread          (Capability *cap,
                               StgTSO     *tso,
                               char       *label);
diff --git a/rts/Threads.c b/rts/Threads.c
index 6a3894ccda..b9f753234f 100644
--- a/rts/Threads.c
+++ b/rts/Threads.c
@@ -176,7 +176,7 @@ cmp_thread(StgPtr tso1, StgPtr tso2)
  *
  * This is used in the implementation of Show for ThreadIds.
  * ------------------------------------------------------------------------ */
-long
+StgThreadID
 rts_getThreadId(StgPtr tso)
 {
   return ((StgTSO *)tso)->id;
@@ -278,8 +278,8 @@ tryWakeupThread (Capability *cap, StgTSO *tso)
         msg->tso = tso;
         SET_HDR(msg, &stg_MSG_TRY_WAKEUP_info, CCS_SYSTEM);
         sendMessage(cap, tso->cap, (Message*)msg);
-        debugTraceCap(DEBUG_sched, cap, "message: try wakeup thread %ld on cap %d",
-                      (W_)tso->id, tso->cap->no);
+        debugTraceCap(DEBUG_sched, cap, "message: try wakeup thread %"
+                      FMT_StgThreadID " on cap %d", tso->id, tso->cap->no);
         return;
     }
 #endif
@@ -305,8 +305,9 @@ tryWakeupThread (Capability *cap, StgTSO *tso)
         i = lockClosure(tso->block_info.closure);
         unlockClosure(tso->block_info.closure, i);
         if (i != &stg_MSG_NULL_info) {
-            debugTraceCap(DEBUG_sched, cap, "thread %ld still blocked on throwto (%p)",
-                          (W_)tso->id, tso->block_info.throwto->header.info);
+            debugTraceCap(DEBUG_sched, cap, "thread %" FMT_StgThreadID " still "
+                          "blocked on throwto (%p)", tso->id,
+                          tso->block_info.throwto->header.info);
             return;
         }
 
@@ -409,9 +410,8 @@ checkBlockingQueues (Capability *cap, StgTSO *tso)
     StgBlockingQueue *bq, *next;
     StgClosure *p;
 
-    debugTraceCap(DEBUG_sched, cap,
-                  "collision occurred; checking blocking queues for thread %ld",
-                  (W_)tso->id);
+    debugTraceCap(DEBUG_sched, cap, "collision occurred; checking blocking "
+                  "queues for thread %" FMT_StgThreadID, tso->id);
 
     for (bq = tso->bq; bq != (StgBlockingQueue*)END_TSO_QUEUE; bq = next) {
         next = bq->link;
@@ -562,9 +562,9 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
         }
 
         debugTrace(DEBUG_gc,
-                   "threadStackOverflow of TSO %ld (%p): stack too large (now %ld; max is %ld)",
-                   (long)tso->id, tso, (long)tso->stackobj->stack_size,
-                   RtsFlags.GcFlags.maxStkSize);
+                   "threadStackOverflow of TSO %" FMT_StgThreadID " (%p): stack"
+                   " too large (now %ld; max is %ld)", 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 */
                  printStackChunk(tso->stackobj->sp,
@@ -914,8 +914,8 @@ printThreadBlockage(StgTSO *tso)
     debugBelch("is blocked on an STM operation");
     break;
   default:
-    barf("printThreadBlockage: strange tso->why_blocked: %d for TSO %ld (%p)",
-         tso->why_blocked, (long)tso->id, tso);
+    barf("printThreadBlockage: strange tso->why_blocked: %d for TSO %"
+         FMT_StgThreadID " (%p)", tso->why_blocked, tso->id, tso);
   }
 }
 
diff --git a/rts/include/rts/Threads.h b/rts/include/rts/Threads.h
index 51c11742ca..46a20089a7 100644
--- a/rts/include/rts/Threads.h
+++ b/rts/include/rts/Threads.h
@@ -18,6 +18,8 @@
 #include <sys/types.h>
 #endif
 
+#include "rts/storage/TSO.h"
+
 //
 // Creating threads
 //
@@ -45,11 +47,11 @@ StgRegTable * resumeThread  (void *);
 //
 // Thread operations from Threads.c
 //
-bool    eq_thread                        (StgPtr tso1, StgPtr tso2);
-int     cmp_thread                       (StgPtr tso1, StgPtr tso2);
-long    rts_getThreadId                  (StgPtr tso);
-void    rts_enableThreadAllocationLimit  (StgPtr tso);
-void    rts_disableThreadAllocationLimit (StgPtr tso);
+bool        eq_thread                        (StgPtr tso1, StgPtr tso2);
+int         cmp_thread                       (StgPtr tso1, StgPtr tso2);
+StgThreadID rts_getThreadId                  (StgPtr tso);
+void        rts_enableThreadAllocationLimit  (StgPtr tso);
+void        rts_disableThreadAllocationLimit (StgPtr tso);
 
 #if !defined(mingw32_HOST_OS)
 pid_t  forkProcess     (HsStablePtr *entry);
diff --git a/rts/include/rts/storage/TSO.h b/rts/include/rts/storage/TSO.h
index 61215d9f38..fcbf7f7ab1 100644
--- a/rts/include/rts/storage/TSO.h
+++ b/rts/include/rts/storage/TSO.h
@@ -8,6 +8,8 @@
 
 #pragma once
 
+#include "rts/storage/Closures.h"
+
 /*
  * PROFILING info in a TSO
  */
@@ -24,6 +26,8 @@ typedef struct {
  */
 typedef StgWord64 StgThreadID;
 
+#define FMT_StgThreadID FMT_Word64
+
 #define tsoLocked(tso) ((tso)->flags & TSO_LOCKED)
 
 /*
diff --git a/rts/posix/Select.c b/rts/posix/Select.c
index b342b0c109..07903865a8 100644
--- a/rts/posix/Select.c
+++ b/rts/posix/Select.c
@@ -106,8 +106,8 @@ static bool wakeUpSleepingThreads (LowResTime now)
         sleeping_queue = tso->_link;
         tso->why_blocked = NotBlocked;
         tso->_link = END_TSO_QUEUE;
-        IF_DEBUG(scheduler, debugBelch("Waking up sleeping thread %lu\n",
-                                       (unsigned long)tso->id));
+        IF_DEBUG(scheduler, debugBelch("Waking up sleeping thread %"
+                                       FMT_StgThreadID "\n", tso->id));
         // MainCapability: this code is !THREADED_RTS
         pushOnRunQueue(&MainCapability,tso);
         flag = true;
@@ -420,15 +420,15 @@ awaitEvent(bool wait)
                    * pass an IOError to blocked threads (#4934)
                    */
                   IF_DEBUG(scheduler,
-                      debugBelch("Killing blocked thread %lu on bad fd=%i\n",
-                                 (unsigned long)tso->id, fd));
+                      debugBelch("Killing blocked thread %" FMT_StgThreadID
+                                 " on bad fd=%i\n", tso->id, fd));
                   raiseAsync(&MainCapability, tso,
                       (StgClosure *)blockedOnBadFD_closure, false, NULL);
                   break;
               case RTS_FD_IS_READY:
                   IF_DEBUG(scheduler,
-                      debugBelch("Waking up blocked thread %lu\n",
-                                 (unsigned long)tso->id));
+                      debugBelch("Waking up blocked thread %" FMT_StgThreadID "\n",
+                                 tso->id));
                   tso->why_blocked = NotBlocked;
                   tso->_link = END_TSO_QUEUE;
                   pushOnRunQueue(&MainCapability,tso);
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index b82eadd9cd..9316f395a8 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -103,7 +103,7 @@ scavengeTSO (StgTSO *tso)
 {
     bool saved_eager;
 
-    debugTrace(DEBUG_gc,"scavenging thread %d",(int)tso->id);
+    debugTrace(DEBUG_gc,"scavenging thread %" FMT_StgThreadID,tso->id);
 
     // update the pointer from the InCall.
     if (tso->bound != NULL) {