Emit the task-tracking events

Based on initial patches by Mikolaj Konarski <mikolaj@well-typed.com>

Use the new task tracing functions traceTaskCreate/Migrate/Delete.
There are two key places. One is for worker tasks which have a
relatively simple life cycle. Worker tasks are created and deleted by
the RTS. The other case is bound tasks which are either created by the
RTS, or appear as foreign C threads making calls into the RTS. For bound
threads we do the tracing in rts_lock/unlock, which actually covers both
threads coming in from outside, and also bound threads made by the RTS.

3 files changed, 39 insertions, 1 deletions

diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c
index 0463f15ad8..c0896f7c6a 100644
--- a/rts/RtsAPI.c
+++ b/rts/RtsAPI.c
@@ -553,6 +553,14 @@ rts_lock (void)
 
     cap = NULL;
     waitForReturnCapability(&cap, task);
+
+    if (task->incall->prev_stack == NULL) {
+      // This is a new outermost call from C into Haskell land.
+      // Until the corresponding call to rts_unlock, this task
+      // is doing work on behalf of the RTS.
+      traceTaskCreate(task, cap);
+    }
+
     return (Capability *)cap;
 }
 
@@ -586,4 +594,11 @@ rts_unlock (Capability *cap)
     // Finally, we can release the Task to the free list.
     boundTaskExiting(task);
     RELEASE_LOCK(&cap->lock);
+
+    if (task->incall == NULL) {
+      // This is the end of an outermost call from C into Haskell land.
+      // From here on, the task goes back to C land and we should not count
+      // it as doing work on behalf of the RTS.
+      traceTaskDelete(task);
+    }
 }
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 326565386a..e6d21465ec 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -1634,7 +1634,12 @@ delete_threads_and_gc:
             while (!emptyRunQueue(tmp_cap)) {
                 tso = popRunQueue(tmp_cap);
                 migrateThread(tmp_cap, tso, dest_cap);
-                if (tso->bound) { tso->bound->task->cap = dest_cap; }
+                if (tso->bound) {
+                  traceTaskMigrate(tso->bound->task,
+                                   tso->bound->task->cap,
+                                   dest_cap);
+                  tso->bound->task->cap = dest_cap;
+                }
             }
         }
     }
@@ -1899,6 +1904,10 @@ forkProcess(HsStablePtr *entry
         initTimer();
         startTimer();
 
+        // TODO: need to trace various other things in the child
+        // like startup event, capabilities, process info etc
+        traceTaskCreate(task, cap);
+
 #if defined(THREADED_RTS)
         ioManagerStartCap(&cap);
 #endif
@@ -2521,6 +2530,8 @@ performGC_(rtsBool force_major)
     // associated with a particular Capability, and chained onto the 
     // suspended_ccalls queue.
     task = newBoundTask();
+    
+    // TODO: do we need to traceTask*() here?
 
     waitForReturnCapability(&cap,task);
     scheduleDoGC(&cap,task,force_major);
diff --git a/rts/Task.c b/rts/Task.c
index b6092e5e41..6c814886ba 100644
--- a/rts/Task.c
+++ b/rts/Task.c
@@ -321,6 +321,11 @@ discardTasksExcept (Task *keep)
         next = task->all_next;
         if (task != keep) {
             debugTrace(DEBUG_sched, "discarding task %" FMT_SizeT "", (size_t)TASK_ID(task));
+            // Note that we do not traceTaskDelete here because
+            // we are not really deleting a task.
+            // The OS threads for all these tasks do not exist in
+            // this process (since we're currently
+            // in the child of a forkProcess).
             freeTask(task);
         }
     }
@@ -383,6 +388,8 @@ workerTaskStop (Task *task)
 
     RELEASE_LOCK(&all_tasks_mutex);
 
+    traceTaskDelete(task);
+
     freeTask(task);
 }
 
@@ -425,6 +432,9 @@ workerStart(Task *task)
 
     newInCall(task);
 
+    // Everything set up; emit the event before the worker starts working.
+    traceTaskCreate(task, cap);
+
     scheduleWorker(cap,task);
 }
 
@@ -443,6 +453,8 @@ startWorkerTask (Capability *cap)
   // worker thread reads it.
   ACQUIRE_LOCK(&task->lock);
 
+  // We don't emit a task creation event here, but in workerStart,
+  // where the kernel thread id is known.
   task->cap = cap;
 
   // Give the capability directly to the worker; we can't let anyone