[project @ 1999-01-21 10:31:41 by simonm]

[ghc-hetmet.git] / ghc / rts / Schedule.c

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index cade908..4ee0892 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.3 1999/01/06 11:44:44 simonm Exp $
+ * $Id: Schedule.c,v 1.5 1999/01/21 10:31:50 simonm Exp $
  *
  * Scheduler
  *
@@ -92,6 +92,7 @@ createThread(nat stack_size)
   }
 
   tso = (StgTSO *)allocate(stack_size);
+  TICK_ALLOC_TSO(stack_size-sizeofW(StgTSO),0);
   
   initThread(tso, stack_size - TSO_STRUCT_SIZEW);
   return tso;
@@ -119,7 +120,7 @@ initThread(StgTSO *tso, nat stack_size)
   SET_HDR((StgClosure*)tso->sp,(StgInfoTable *)&stg_stop_thread_info,CCS_MAIN);
   tso->su = (StgUpdateFrame*)tso->sp;
 
-  IF_DEBUG(scheduler,belch("Initialised thread %lld, stack size = %lx words\n", 
+  IF_DEBUG(scheduler,belch("Initialised thread %ld, stack size = %lx words\n", 
                           tso->id, tso->stack_size));
 
   /* Put the new thread on the head of the runnable queue.
@@ -160,7 +161,7 @@ void deleteThread(StgTSO *tso)
       return;
     }
 
-    IF_DEBUG(scheduler, belch("Killing thread %lld.", tso->id));
+    IF_DEBUG(scheduler, belch("Killing thread %ld.", tso->id));
 
     tso->whatNext = ThreadKilled; /* changed to ThreadComplete in schedule() */
     tso->link = END_TSO_QUEUE; /* Just to be on the safe side... */
@@ -192,6 +193,7 @@ void deleteThread(StgTSO *tso)
       int words = (stgCast(StgPtr,su) - stgCast(StgPtr,sp)) - 1;
       nat i;
       StgAP_UPD* ap = stgCast(StgAP_UPD*,allocate(AP_sizeW(words)));
+      TICK_ALLOC_THK(words+1,0);
 
       /* First build an AP_UPD consisting of the stack chunk above the
        * current update frame, with the top word on the stack as the
@@ -245,6 +247,7 @@ void deleteThread(StgTSO *tso)
          
          /* now build o = FUN(catch,ap,handler) */
          o = stgCast(StgClosure*, allocate(sizeofW(StgClosure)+2));
+         TICK_ALLOC_THK(2,0);
          SET_HDR(o,&catch_info,su->header.prof.ccs /* ToDo */);
          payloadCPtr(o,0) = stgCast(StgClosure*,ap);
          payloadCPtr(o,1) = cf->handler;
@@ -270,6 +273,7 @@ void deleteThread(StgTSO *tso)
          
          /* now build o = FUN(seq,ap) */
           o = stgCast(StgClosure*, allocate(sizeofW(StgClosure)+1));
+         TICK_ALLOC_THK(1,0);
          SET_HDR(o,&seq_info,su->header.prof.ccs /* ToDo */);
          payloadCPtr(o,0) = stgCast(StgClosure*,ap);
          
@@ -363,7 +367,7 @@ SchedulerStatus schedule(StgTSO *main, StgClosure **ret_val)
     ccalling_threads = CurrentTSO;
     in_ccall_gc = rtsTrue;
     IF_DEBUG(scheduler,
-            fprintf(stderr, "Re-entry, thread %lld did a _ccall_gc\n", 
+            fprintf(stderr, "Re-entry, thread %d did a _ccall_gc\n", 
                     CurrentTSO->id););
   } else {
     in_ccall_gc = rtsFalse;
@@ -391,7 +395,12 @@ SchedulerStatus schedule(StgTSO *main, StgClosure **ret_val)
     } else {
       context_switch = 0;
     }
-    IF_DEBUG(scheduler, belch("Running thread %lld...\n", t->id));
+    IF_DEBUG(scheduler, belch("Running thread %ld...\n", t->id));
+
+    /* Be friendly to the storage manager: we're about to *run* this
+     * thread, so we better make sure the TSO is mutable.
+     */
+    recordMutable((StgMutClosure *)t);
 
     /* Run the current thread */
     switch (t->whatNext) {
@@ -441,14 +450,14 @@ SchedulerStatus schedule(StgTSO *main, StgClosure **ret_val)
     switch (ret) {
 
     case HeapOverflow:
-      IF_DEBUG(scheduler,belch("Thread %lld stopped: HeapOverflow\n", t->id));
+      IF_DEBUG(scheduler,belch("Thread %ld stopped: HeapOverflow\n", t->id));
       threadPaused(t);
       PUSH_ON_RUN_QUEUE(t);
       GarbageCollect(GetRoots);
       break;
 
     case StackOverflow:
-      IF_DEBUG(scheduler,belch("Thread %lld stopped, StackOverflow\n", t->id));
+      IF_DEBUG(scheduler,belch("Thread %ld stopped, StackOverflow\n", t->id));
       { 
        nat i;
        /* enlarge the stack */
@@ -474,9 +483,9 @@ SchedulerStatus schedule(StgTSO *main, StgClosure **ret_val)
                   /* ToDo: or maybe a timer expired when we were in Hugs?
                    * or maybe someone hit ctrl-C
                     */
-                   belch("Thread %lld stopped to switch to Hugs\n", t->id);
+                   belch("Thread %ld stopped to switch to Hugs\n", t->id);
                } else {
-                   belch("Thread %lld stopped, timer expired\n", t->id);
+                   belch("Thread %ld stopped, timer expired\n", t->id);
                }
                );
       threadPaused(t);
@@ -510,7 +519,7 @@ SchedulerStatus schedule(StgTSO *main, StgClosure **ret_val)
       break;
 
     case ThreadBlocked:
-      IF_DEBUG(scheduler,belch("Thread %lld stopped, blocking\n", t->id));
+      IF_DEBUG(scheduler,belch("Thread %ld stopped, blocking\n", t->id));
       threadPaused(t);
       /* assume the thread has put itself on some blocked queue
        * somewhere.
@@ -518,7 +527,7 @@ SchedulerStatus schedule(StgTSO *main, StgClosure **ret_val)
       break;
 
     case ThreadFinished:
-      IF_DEBUG(scheduler,belch("Thread %lld finished\n", t->id));
+      IF_DEBUG(scheduler,belch("Thread %ld finished\n", t->id));
       deleteThread(t);
       t->whatNext = ThreadComplete;
       break;
@@ -673,6 +682,7 @@ threadStackOverflow(StgTSO *tso)
   IF_DEBUG(scheduler, fprintf(stderr,"increasing stack size from %d words to %d.\n", tso->stack_size, new_stack_size));
 
   dest = (StgTSO *)allocate(new_tso_size);
+  TICK_ALLOC_TSO(new_tso_size-sizeofW(StgTSO),0);
 
   /* copy the TSO block and the old stack into the new area */
   memcpy(dest,tso,TSO_STRUCT_SIZE);
@@ -690,7 +700,14 @@ threadStackOverflow(StgTSO *tso)
   /* and relocate the update frame list */
   relocate_TSO(tso, dest);
 
-  IF_DEBUG(sanity,checkTSO(tso,0)); /* Step 0 because we're not GC'ing. */
+  /* Mark the old one as dead so we don't try to scavenge it during
+   * garbage collection (the TSO will likely be on a mutables list in
+   * some generation, but it'll get collected soon enough).
+   */
+  tso->whatNext = ThreadKilled;
+  dest->mut_link = NULL;
+
+  IF_DEBUG(sanity,checkTSO(tso));
 #if 0
   IF_DEBUG(scheduler,printTSO(dest));
 #endif
@@ -714,7 +731,7 @@ void awaken_blocked_queue(StgTSO *q)
     tso = q;
     q = tso->link;
     PUSH_ON_RUN_QUEUE(tso);
-    IF_DEBUG(scheduler,belch("Waking up thread %lld", tso->id));
+    IF_DEBUG(scheduler,belch("Waking up thread %ld", tso->id));
   }
 }