diff options
-rw-r--r-- | libraries/base/GHC/Conc/Sync.hs | 2 | ||||
-rw-r--r-- | rts/Messages.c | 18 | ||||
-rw-r--r-- | rts/RaiseAsync.c | 5 | ||||
-rw-r--r-- | rts/Schedule.c | 8 | ||||
-rw-r--r-- | rts/Task.c | 4 | ||||
-rw-r--r-- | rts/ThreadLabels.c | 6 | ||||
-rw-r--r-- | rts/ThreadLabels.h | 4 | ||||
-rw-r--r-- | rts/Threads.c | 26 | ||||
-rw-r--r-- | rts/include/rts/Threads.h | 12 | ||||
-rw-r--r-- | rts/include/rts/storage/TSO.h | 4 | ||||
-rw-r--r-- | rts/posix/Select.c | 12 | ||||
-rw-r--r-- | rts/sm/Scav.c | 2 |
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) { |