summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libraries/base/GHC/Conc/Sync.hs2
-rw-r--r--rts/Messages.c18
-rw-r--r--rts/RaiseAsync.c5
-rw-r--r--rts/Schedule.c8
-rw-r--r--rts/Task.c4
-rw-r--r--rts/ThreadLabels.c6
-rw-r--r--rts/ThreadLabels.h4
-rw-r--r--rts/Threads.c26
-rw-r--r--rts/include/rts/Threads.h12
-rw-r--r--rts/include/rts/storage/TSO.h4
-rw-r--r--rts/posix/Select.c12
-rw-r--r--rts/sm/Scav.c2
12 files changed, 55 insertions, 48 deletions
diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs
index 8bab43b966..b05fe06f4f 100644
--- a/libraries/base/GHC/Conc/Sync.hs
+++ b/libraries/base/GHC/Conc/Sync.hs
@@ -152,7 +152,7 @@ instance Show ThreadId where
showThreadId :: ThreadId -> String
showThreadId = show
-foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> CInt
+foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> CULLong
id2TSO :: ThreadId -> ThreadId#
id2TSO (ThreadId t) = t
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) {